perm filename LOSS.1[NEW,LSP]8 blob
sn#659300 filedate 1982-05-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 PIHOLD PINBL STDMSK DBGMSK STDMS2 DBGMS2 INTVEC TTYDF1 TTYDF2 LINTVEC
C00009 00003 TERMIN
C00014 00004 AIC MAKE SURE THE IMPORTANT INTERRUPTS ARE ON
C00019 00005 ILLEGAL MEMORY WRITE
C00025 00006 SETOM INTALL FLAG THAT ALL INTERRUPTS HAVE BEEN DISABLED
C00032 00007 INTERNAL LISP ERROR\]
C00038 00008 MOVEM T,.JBOPC
C00043 00009 PUSH T,F
C00048 00010 MOVEM D,IPSPC(F) STORE WHERE OLD PC WENT
C00053 00011 $XLOSE: MOVEI R,$XLOST CAUSE INTERRUPT DURING AN ≠X
C00057 00012 PRESENTLY ONLY TWO KINDS ARE HANDLED:
C00062 00013 SETZM TAPWRT
C00066 00014 SA% TRZN R,%TX<CTL> DOWN TO 7 IF NECESSARY
C00070 00015 MOVSI R,400000 SHUT CLOCK BACK OFF
C00074 00016 MOVSM D,INTAR+1
C00079 00017 UIMILO==:1 EVAL ILLEGAL OPERATION
C00083 00018
C00089 00019 UINT40: SKIPGE UIFRM-1(P)
C00094 00020 SKIPE PSYMF
C00098 00021 MOVEI R,-15(TT)
C00102 00022 PUSH P,A
C00107 00023 TABLE OF WHERE TO FIND THE ACS AS THEY WERE ON UUO ENTRY
C00111 00024 JSR UUOBKG
C00115 00025 MOVEI A,0
C00119 00026 UUOS: SKIPA TT,40 *** NONATOMICFUN CALLED LIKE SUBR
C00121 ENDMK
C⊗;
;PIHOLD PINBL STDMSK DBGMSK STDMS2 DBGMS2 INTVEC TTYDF1 TTYDF2 LINTVEC
SUBTTL INTERRUPT HANDLERS
PGBOT INT
IFN ITS,[
PIHOLD: .SPICLR,,R70 ;WORD TO ".SUSET" TO TURN OFF INTERRUPT SYSTEM
PINBL: .SPICLR,,XC-1 ;WORD TO ".SUSET" TO TURN ON INTERRUPT SYSTEM
;;; NEW-STYLE INTERRUPT TRANSFER VECTOR
.SEE IMASK
;;; STANDARD VALUES TO PUT IN .MASK AND .MSK2 USER VARIABLES.
;;; INTERRUPTS NORMALLY ENABLED ARE:
;;; PARITY ERROR
;;; WRITE INTO READ-ONLY MEMORY
;;; MEMORY PROTECTION VIOLATION
;;; ILLEGAL OPERATION
;;; PDL OVERFLOW
;;; I/O CHANNEL ERROR
;;; RUN TIME CLOCK
;;; REAL TIME CLOCK
;;; ALSO, FOR THE USELESS SWITCH:
;;; CLI DEVICE INTERRUPT
;;; SYSTEM GOING DOWN/REVIVED
;;; SYSTEM BEING DEBUGGED
;;; CONTROL OF TTY JUST GIVEN BACK TO LISP
;;; (SSTATUS MAR) MAY ALSO ENABLE THE MAR INTERRUPT
.SEE SSMAR
STDMSK=%PIPAR+%PIWRO+%PIMPV+%PIILO+%PIPDL+%PIIOC+%PIRUN+%PIRLT
IFN USELESS, STDMSK=STDMSK+%PIDWN+%PIDBG+%PIATY
DBGMSK=STDMSK-<%PIPAR+%PIMPV+%PIILO+%PIATY>
;;; ALL I/O CHANNELS ARE ENABLED, AND ALL JOB CHANNELS FOR USELESS SWITCH.
STDMS2==177777
IFN JOBQIO, STDMS2==STDMS2+<377,,>
DBGMS2==STDMS2
DEFINE INTGRP HANDLER+PIRQC=0,IFPIR=0,DF1=STDMSK+%PIMAR-<%PIPDL+%PIPAR+%PIWRO+%PIMPV+%PIILO>,DF2=STDMS2
PIRQC
IFPIR
DF1
DF2
HANDLER
TERMIN
INTVEC: D←6+3,,INTPDL ;PDL FOR PUSHING INTERRUPT STUFF
;ACS D, R, F ARE SAVED ALONG WITH OTHER CRUD
INTGRP MEMERR,PIRQC=%PIPAR+%PIWRO+%PIMPV+%PIILO,DF1=STDMSK+%PIMAR-%PIPDL ;MEMORY AND OPCODE ERRORS
INTGRP PDLOV,PIRQC=%PIPDL ;PDL OVERFLOW
INTGRP IOCERR,PIRQC=%PIIOC ;I/O CHANNEL ERROR
IFN USELESS, INTGRP CLIINT,PIRQC=%PICLI ;CLI INTERRUPT
IFN USELESS, INTGRP TTRINT,PIRQC=%PIATY ;TTY RETURNED TO JOB
IFN USELESS, INTGRP SYSINT,PIRQC=%PIDWN+%PIDBG ;SYS DOWN OR BEING DEBUGGED
IFN JOBQIO, INTGRP JOBINT,IFPIR=[377,,] ;INFERIOR PROCEDURES
INTGRP CHNINT,IFPIR=177777 ;I/O CHANNEL INTERRUPTS
TTYDF1==:.-3 .SEE UINT0
TTYDF2==:.-2
IFN USELESS, INTGRP MARINT,PIRQC=%PIMAR ;MAR BREAK
INTGRP RUNCLOCK,PIRQC=%PIRUN ;RUNTIME ALARMCLOCK
INTGRP REALCLOCK,PIRQC=%PIRLT ;REAL TIME ALARMCLOCK
LINTVEC==:.-INTVEC ;LENGTH OF INTERRUPT VECTOR
;;; NOTE THE EFFECT OF HAVING THE ALARMCLOCKS LAST:
;;; IOC AND CHANNEL INTERRUPT HAPPEN FIRST, BUT WHEN
;;; THE PION HAPPENS INSIDE UINT0 THE ALARMCLOCK GETS
;;; ITS TURN IMMEDIATELY. FURTHERMORE, THE REAL TIME
;;; CLOCK GETS SLIGHTLY HIGHER PRECEDENCE.
] ;END OF IFN ITS
;DISMSK DISMSK STDMSK STDMSK STDMSK DBGMSK CHNTAB LEVTAB ENBINT ENBIN2 ENBIN1 REAINT DALINT DISINT DSMINT INTSUP $PDLOV INTNXP INTIRD INTMPV INTIWR INTILO INTMER INTASS ASSIN1 ASSRET
IFN D20,[
;;; TOPS-20 INTERRUPT HANDLER
;;; INTERRUPTS NOMRALLY ENABLED ARE:
;;; PDL OVERFLOW
;;; ILLEGAL INSTRUCTION
;;; ILLEGAL MEMORY READ
;;; ILLEGAL MEMORY WRITE
;;; NONEXISTANT PAGE REFERENCE
;;; VARIOUS CHARACTERS ENABLED FOR INTERRUPTS:
;;; ↑A, ↑B, ↑D, ↑E, ↑F, ↑G, ↑V, ↑W, ↑X, ↑Z
;;; CHANNEL ASSIGNMENTS:
;;; 1) PDL OV
;;; 2) ILLEGAL INSTRUCTION, ILL MEM R & W, OTHER SYNC INTERRUPTS
;;; 3) ASYNCHRONOUS INTERRUPTS
DISMSK==0 ;GENERATE IMPORTANT INTERRUPTS MASK
IRP FOO,,[.ICPOV,.ICILI,.ICIRD,.ICIWR,.ICNXP]
DISMSK==DISMSK+<1←<35.-FOO>>
TERMIN
STDMSK==DISMSK ;GENERATE STANDARD INTERRUPT MASK
IRP FOO,,[.ICDAE]
STDMSK==STDMSK+<1←<35.-FOO>>
TERMIN
STDMSK==STDMSK+<770000,,007777> ;ALSO INCLUDE ALL USER ASSIGNABLE CHANNELS
DBGMSK==STDMSK ;FOR NOW, MASKS ARE EQUIVALENT
;CHANNEL TABLE (ASSIGNS A PRIORITY LEVEL AND HANDLER ADR TO EACH CHANNEL)
CHNTAB:
REPEAT 6, 3,,INTASS+<.RPCNT*3> ;FIRST 6 ASSIGNABLE INTERRUPTS
0 ? 0 ? 0 ;ARITHMETIC OVERFLOWS
1,,$PDLOV ;PLDOV
0 ? 0 ;E-O-F AND DATA-ERROR
0 ? 0 ? 0 ;RESERVED TO DEC
2,,INTILO ;ILLEGAL INSTRUCTION
2,,INTIRD ;ILLEGAL MEMORY READ
2,,INTIWR ;ILLEGAL MEMORY WRITE
0 ? 0 ? 0 ? 0 ;RESERVED, AND ?
2,,INTNXP ;NON-EXISTANT PAGE
0 ; CHANNEL 23. LOSES!
REPEAT CINTSZ-6, 3,,INTASS+<6+.RPCNT>*3 ;REMAINING ASSIGNABLE INTERRUPTS
IFN .-CHNTAB-36., WARN [WRONG NUMBER ENTRIES IN CHNTAB?]
;LEVEL TABLE - WHERE TO STORE PC FOR INTERRUPT AT EACH PI LEVEL
LEVTAB: 0,,INTPC1
0,,INTPC2
0,,INTPC3
;;; TOPS-20 INTERRUPT HANDLING ROUTINES
;;; CALLED AT STARTUP TO REINITIALIZE THE INTERRUPT SYSTEM
ENBINT: MOVEI 1,.FHSLF ;MANIPULATE OURSELVES
MOVE 2,[LEVTAB,,CHNTAB] ;INTERRUPT PC STORAGE TAB,,CHANNEL LOC TAB
SIR ;SPECIFY THE TABLES
SETZ T, ;LOOP OVER AND ASSIGN TTY INTERRUPT CHANNELS
ENBIN2: SKIPG 1,CINTAB(T) ;THIS ENTRY USED FOR TTY INTERRUPT?
JRST ENBIN1 ;NOPE, GO ON
MOVSS 1 ;CHARACTER GOES IN LEFT HALF
HRRI 1,(T) ;CHANNEL IN RIGHT HALF
CAIL T,6 ;RELOCTAION NECESSARY?
ADDI 1,24.-6 ;YES, MAKE REAL CHANNEL NUMBER
ATI ;ASSIGN TERMINAL INTERRUPT CHANNEL
ENBIN1: CAIGE T,CINTSZ-1 ;DONE?
AOJA T,ENBIN2
MOVEI 1,.FHSLF ;ENABLE APPROPRIATE CHANNELS
MOVE 2,[STDMSK] ;ENABLE STANDARD INTERRUPTS
MOVEM 2,IMASK ;THIS IS CURRENT INTERRUPT MASK
MOVEM 2,OIMASK ;THIS IS ALSO THE OLD-MASK
AIC
MOVEI 1,.FHSLF ;ENABLE OUR INTERRUPT SYSTEM
XCTPRO
EIR
SETZB 1,2 ;DON'T LEAVE RANDOMNESS IN PROTECTED ACS
NOPRO
POPJ P,
;REENABLES INTERRUPTS AFTER THEY HAVE BEEN DISABLED BY DALINT OR DISINT
REAINT: PUSH P,1
PUSH P,2
XCTPRO
AOSE INTALL ;DISABLED ALL INTS?
SKIPA 2,OIMASK ;NO, USE OLD INTERRUPT MASK
SKIPA 2,IMASK ;ELSE USE CURRENT MASK
MOVEM 2,IMASK ;THIS IS NOW THE CURRENT MASK
MOVEI 1,.FHSLF ;REENABLE INTERRUPTS FOR OURSELF
AIC
POP P,2
POP P,1
NOPRO
POPJ P,
;THIS ROUTINE DISABLES ALL INTERRUPTS FROM OCCURING
;THE FLAG INTALL IS SET SAYING TO TELL THE RE-ENABLE ROUTINE TO RESTORE
; INTERRUPTS FROM IMASK RATHER THAN OIMASK
WARN [THINK ABOUT USING 'DIR' FOR DALINT]
DALINT: PUSH P,1
PUSH P,2
XCTPRO
MOVEI 1,.FHSLF ;DEFER ALL INTERRUPTS
SETO 2,
DIC
SETOM INTALL ;FLAG THAT ALL INTERRUPTS HAVE BEEN DISABLED
POP P,2
POP P,1
NOPRO
POPJ P,
;DISABLE ALL BUT IMPORTANT INTERRUPTS
;IMASK IS MOVED TO OIMASK, AND IMASK IS SETUP TO NEW CURRENT MASK VALUE
DISINT: PUSH P,1 ;WE WILL NEED TWO WORKING ACS
PUSH P,2
XCTPRO
MOVE 2,IMASK ;GET CURRENT INTERRUPT MASK
MOVEM 2,OIMASK ;UPDATE OLD MASK
AND 2,[DISMSK] ;ONLY ALLOW IMPORTANT INTERRUPTS
MOVEM 2,IMASK ;NEW MASK
MOVEI 1,.FHSLF
AIC ;MAKE SURE THE IMPORTANT INTERRUPTS ARE ON
SETCA 2,
DIC ;BUT ONLY THE IMPORTANT INTERRUPTS
POP P,2
POP P,1
NOPRO
POPJ P,
;;; DISMISS AN INTERRUPT
DSMINT:
XCTPRO
AOS DSMSAV ;POINT TO NEXT FREE LOCATION (A SMALL STACK)
MOVEM 1,@DSMSAV ;SAVE AC 1
MOVEI 1,.FHSLF ;TURN OFF SYSTEM INTS WHILE MUNGING INTPDL
DIR
MOVE 1,INTPDL ;NOW UNDO INTPDL
POP 1,F
POP 1,R
POP 1,D
POP 1,@-1(1) ;RESTORE RETURN PC
SUB 1,R70+1 ;THROW AWAY RETURN PC POINTER
POP 1,IMASK ;RESTORE OLD IMASK
SUB 1,R70+2
MOVEM 1,INTPDL
MOVEI 1,.FHSLF
EIR ;NOW ALLOW INTERRUPTS
MOVEI 1,.FHSLF
AOS DSMSAV ;SAVE AC 2 ON TOP OF STACK
MOVEM 2,@DSMSAV
MOVE 2,IMASK ;TELL TOPS-20 ABOUT OLD IMASK
AIC
MOVE 2,@DSMSAV ;RESTORE AC'S
SOS DSMSAV
MOVE 1,@DSMSAV
SOS DSMSAV
NOPRO
DEBRK ;THEN DISMISS THE CURRENT INTERRUPT
;;; INTPDL BUILDER: RETURNS INTPDL IN F, ACCEPTS PC POINTER ON FLP
INTSUP:
XCTPRO ;NEED PROTECTION AS WE WILL USE MARKED ACS
MOVEM 1,SUPSAV ;SAVE NEEDED REGISTER
MOVEI 1,.FHSLF ;TURN OFF THE INTERRUPT SYSTEM WHILE TOUCHING
DIR ; INTPDL
MOVE 1,INTPDL
PUSH 1,NIL ;IPSWD1 AND IPSWD2
PUSH 1,NIL
PUSH 1,IMASK ;IMASK UPON ENTRY
PUSH 1,F ;SAVE THE PC POINTER
HRRZS (1) ;BUT ONLY RH
PUSH 1,(F) ;AND SAVE THE PC
PUSH 1,D ;SAVE PRESERVED ACS
PUSH 1,R
HLRZS F ;RH NOW HAS ADR OF F
PUSH 1,(F) ;SAVES F
MOVE F,1 ;COPY OF INTPDL TO F
MOVEM F,INTPDL ;SAVE INTPDL
MOVEI 1,.FHSLF ;REEANBLE INTERRUPTS
EIR
MOVE 1,SUPSAV
NOPRO
JRST (T) ;RETURN TO CALLER
;;; THE ACTUAL INTERRUPT HANDLERS
;PDL OVERFLOW
$PDLOV: MOVEM T,PDLSVT ;SAVE T SO THAT WE HAVE AN AC TO USE
MOVE T,INTPDL ;FUDGE INTPDL STACK FRAME
PUSH T,NIL ;IPSWD1 AND IPSWD2 UNUSED
PUSH T,NIL
PUSH T,IMASK ;SAVE IMASK UPON ENTRY
PUSH T,LEVTAB ;RH IS INTERRUPT PC ADR, @ AND () FIELDS OFF
PUSH T,@LEVTAB ;SAVE PC
PUSH T,D
PUSH T,R
PUSH T,F
MOVEM T,INTPDL ;STORE NEW INTPDL POINTER
MOVE T,PDLSVT ;RESTORE AC T
JRST PDLOV ;THEN PROCESS PDL OV
;;; PRIORITY LEVEL 2 INTERRUPT HANDLERS
;INTERRUPT AFTER NEWLY CREATED PAGE
INTNXP: MOVEM T,LV2SVT
MOVE T,@LEVTAB+1
HLRZ T,(T) ;GET THE INSTRUCTION THAT CAUSED THE GRIEF
TRZ T,000037 ;ANY INDEX OR INDIRECTION IS OK
CAIE T,(SETMM) ;SPECIAL WAY TO CREATE A PAGE, SO ALL IS OK
JRST INTMPV ;OTHERWISE IS BAD NEWS
MOVE T,LV2SVT ;ELSE RESTORE T
DEBRK ;AND RETURN INSTANTLY
;ILLEGAL MEMORY READ
INTIRD: MOVEM T,LV2SVT ;TREAT ILLEGAL MEMORY READ AS MPV
;HERE ON MEMORY PROTECTION VIOLATION, T SAVED ON FXP
INTMPV: MOVEI T,%PIMPV ;TURN INTO AN MPV
JRST INTMER ;AND TREAT LIKE OTHER MEMORY ERRORS
;ILLEGAL MEMORY WRITE
INTIWR: MOVEM T,LV2SVT
MOVSI T,(%PIWRO) ;WRITE INTO READ-ONLY MEMORY
JRST INTMER
;ILLEGAL OP
INTILO: MOVEM T,LV2SVT
MOVEI T,%PIILO ;ILLEGAL OPERATION
;COMMON MEMORY ERROR HANDLER, T IS PUSHED ON FXP AND CONTAINS THE ERROR BIT
;FUDGE INTPDL AND JRST OFF TO MEMERR
INTMER: MOVEM F,LV2SVF ;SAVE F IN KNOWN PLACE
MOVEM T,LV2ST2 ;ALSO SAVE FLAGS
MOVE F,[LV2SVF,,INTPC2] ;WHERE F IS,,WHERE PC IS
JSP T,INTSUP ;SETUP INTPDL, RETURN INTPDL IN F
MOVE T,LV2ST2 ;GET BACK FLAG BITS
MOVEM T,IPSWD1(F) ;STORE MEMORY ERROR BITS
MOVE T,LV2SVT ;RESTORE ACTUAL CONTENTS OF T
JRST MEMERR ;THEN PROCESS THE MEMORY ERROR
;;; ASSIGNABLE INTERRUPT HANDLER
INTASS:
REPEAT CINTSZ,[
MOVEM T,LV3SVT ;SAVE AC T
MOVEI T,.RPCNT ;INDEX INTO CINTAB
JRST ASSIN1 ;THEN USE COMMON CODE
]
ASSIN1: SKIPN CINTAB(T) ;ASSIGNED CHANNEL?
JRST ASSRET ;NOPE, RANDOM INTERRUPT; JUST RETURN
SKIPG CINTAB(T) ;'CHANNEL' INTERRUPT (A CHARACTER?)
HALT ;NO, SOME OTHER TYPE, BUT NONE SUPPORTED YET...
MOVEM F,LV3SVF
MOVE F,[LV3SVF,,INTPC3]
MOVEM T,LV3ST2 ;SAVE INTERRUPT TABLE INDEX
JSP T,INTSUP ;SETUP INTPDL
MOVE T,LV3ST2
HRRZ T,CINTAB(T) ;GET THE INTERRUPT CHARACTER
TRO T,400000 ;FLAG AS INTERNAL
MOVEM T,IPSWD2(F) ;STORE ON INTPDL
MOVE T,LV3SVT ;RESTORE ORIGIONAL CONTENTS OF T
JRST CHNINT ;THEN PROCESS THE CHANNEL INTERRUPT
ASSRET: MOVE T,LV3SVT ;RESTORE ORIGIONAL CONTENTS OF T
DEBRK ;THEN RETURN TO MAIN PROGRAM
] ;END IFN D20
;ENBINT REAINT REAIN1 DISINT DALINT INTRPT MAILINT DSMINT INTERR PARINT NXMINT ILMINT SAIMER EYEINT SAIIMS SAIDSP
IFN SAIL,[
;SAIL NEWIO INTERRUPT CODE
;CALLED TO REINITIALIZE THE INTERRUPT SYSTEM
ENBINT: MOVEI T,INTRPT ;FLAGS,,INTERRUPT LOCATION
MOVEM T,.JBAPR ;LOCATION SO MONITOR KNOWS
SETZM INTALL ;DID A 'DALINT' LAST (ALL INTS ARE MASKED)
SETOB T,REEINT ;ALL INTERRUPTS INCLUDING REENTER
SETOM REENOP ;BUT MUST SET BOTH FLAGS
IWKMSK T ;ALL GET US OUT OF IWAIT
INTMSK T ;ALL ARE MASKED ON
MOVE T,[STDMSK] ;ENABLE STANDARD INTERRUPTS
MOVEM T,IMASK ;THIS IS CURRENT INTERRUPT MASK
MOVEM T,OIMASK ;THIS IS ALSO THE OLD-MASK
INTENB T, ;TELL OPERATING SYSTEM WHICH INTS TO GENERATE
MOVEI T,REETRP ;REENTER TRAP ADR
MOVEM T,.JBREN ;ALLOW REENTER AS MEANS OF IOC INTERRUPT
POPJ P,
;REENABLES INTERRUPTS AFTER THEY HAVE BEEN DISABLED BY DALINT OR DISINT
REAINT: PUSH FXP,T
AOSE INTALL ;DISABLED ALL INTS?
SKIPA T,OIMASK ;NO, USE OLD INTERRUPT MASK
SKIPA T,IMASK ;ELSE USE CURRENT MASK
MOVEM T,IMASK ;THIS IS NOW THE CURRENT MASK
INTMSK T ;THEN UNMASK CORRECT SET OF INTERRUPTS
SKIPG REEINT
JRST REAIN1
MOVEI T,CPOPJ
MOVEM T,.JBOPC
POP FXP,T
JRST REETR1 ;FUDGE A REENTER IF ONE WAS REQUESTED
REAIN1: POP FXP,T
SETOM REEINT
POPJ P,
;DISABLE ALL BUT IMPORTANT INTERRUPTS
;IMASK IS MOVED TO OIMASK, AND IMASK IS SETUP TO NEW CURRENT MASK VALUE
DISINT: PUSH FXP,T ;WE WILL NEED A WORKING AC
MOVE T,IMASK ;GET CURRENT INTERRUPT MASK
MOVEM T,OIMASK ;UPDATE OLD MASK
ANDCM T,[INTPAR\INTPOV\INTILM\INTNXM] ;ONLY ALLOW THESE INTERRUPTS
MOVEM T,IMASK ;NEW MASK
INTMSK T ;TELL OPERATING SYSTEM
SETZM REEINT ;ALSO DISALLOW REENTERS
POP FXP,T
POPJ P,
;THIS ROUTINE DISABLES ALL INTERRUPTS FROM OCCURING
;THE FLAG INTALL IS SET SAYING TO TELL THE RE-ENABLE ROUTINE TO RESTORE
; INTERRUPTS FROM IMASK RATHER THAN OIMASK
DALINT: INTMSK R70 ;MASK OFF ALL INTERRUPTS
SETOM INTALL ;FLAG THAT ALL INTERRUPTS HAVE BEEN DISABLED
POPJ P,
;HERE TO PROCESS AN INTERRUPT
;OPERATING SYSTEM JUMPS TO HERE WITH ALL ACS SAVED AND SET UP WITH INTERRUPT
;STATUS; THE OBJECT IS TO SAVE INTERRUPT DEPENDANT DATA AND THEN REENABLE
;THE INTERRUPT SYSTEM AS SOON AS POSSIBLE....NOTE THAT THIS MUST DISABLE
;INTERRUPTS DEPENDING UPON WHICH ONE WAS GENERATED.
;--INTERRUPT-- --DISABLES--
;MEMORY ERROR ALL EXCEPT PDL OV
;<ESC>I <ESC>I AND REENTER
;PDL OV ALL EXCEPT MEMORY ERROR AND PDL OV
;CLOCK CLOCK
INTRPT: MOVE A,INTPDL ;DON'T WORRY ABOUT SPACEWAR BUTTONS
SETZM REENOP ;NO ∧C/REENTER TRAPS NOW
MOVE B,.JBCNI ;GET INTERRUPT
PUSH A,B ;SAVE INTERRUPT CONDITIONS
PUSH A,10 ;SAVE ARGUMENT TO INTERRUPT (FOR <ESC>I)
PUSH A,IMASK ;DEFERRED INTERRUPT MASK CURRENTLY ACTIVE
JFFO B,.+1 ;GET INTERRUPT NUMBER INTO AC B+1
PUSH A,B+1 ;STORE THIS ON INTPDL
MOVE B+1,SAIIMS(B+1) ;THIS WILL BE NEW IMASK (F HAS INT NUMBER)
MOVEM B+1,IMASK
INTMSK B+1
PUSH A,.JBTPC ;SAVE ADR INTERRUPT EMANATES FROM
PUSH A,NIL ;SAVE DUMMY WORDS TO HOLD ACS D, R, F
PUSH A,NIL
PUSH A,NIL
MOVEM A,INTPDL ;THIS IS NEW INTERRUPT PDL POINTER
UWAIT ;UWAIT WILL RESTORE USER AC'S
EXCH F,INTPDL ;SAVE F, GET POINTER TO INTPDL
MOVEM D,IPSD(F) ;SAVE D
MOVEM R,IPSR(F) ;SAVE R
MOVE R,.JBTPC
SUB R,IPSPC(F) ;OTHER JBTPC
CAILE R,4 ;WITHIN 4
HALT
MOVEM R,IPSPC(F) ;THE REAL RETURN PC
MOVEI R,(F) ;COPY INTPDL INTO R
EXCH F,INTPDL ;RESTORE STATE OF F AND INTPDL
MOVEM F,IPSF(R) ;THEN SAVE F
DEBREAK ;NOW GO TO USER LEVEL BUT NOT TO USER PROGRAM
JRST @SAIDSP(F) ;DISPATCH ON INTERRUPT INDEX
;MAIL INTERRUPT SETS THE MAILINT FLAG (SAIL-MAIL-INTERRUPT)
IFN SAIL,[
MAIINT:
SKIPE V.MAILINT
JRST MAIIN2
MOVE T,@V.MAILINT ;GET THE VALUE
MAIL 2,T ;GET THE MAIL
JRST DSMINT ;FALSE ALARM
HLRZ R,(T) ;VALIDATION
CAIE R,(SIXBIT /EPR/)
JRST MAIIN3 ;LOSE
HRRZ R,(T) ;JOBNUM
CAME R,@VEJOBNUM ;RIGHT JOBNUM
JRST MAIIN3 ;LOSE
MOVE R,1(T) ;GET TYPE OF MESSAGE
CAIN R,3 ;IS IT A REAL CONTROL CHAR?
JRST DSMINT ;NO, JUST REPORT THE INCIDENT
MOVE R,2(T) ;STUFF CHARACTER
JRST CHNIZ ;DO THE INTERRUPT
MAIIN3: SETZM V.MAILINT
JRST DSMINT
MAIIN2: MOVEI T,TRUTH
MOVEM T,V.MAILINT
] ;END IFN SAIL
;DISMISS AN INTERRUPT
DSMINT: PUSH FXP,T
MOVE T,INTPDL
MOVE F,IPSDF1(T) ;RESTORE APR FLAGS TO THOSE AT INTERRUPT TIME
MOVEM F,IMASK
INTMSK F
POP T,F
POP T,R
POP T,D
PUSH P,(T) ;RETURN PC
POPI T,5
MOVEM T,INTPDL ;RESTORE INTPDL
POP FXP,T
SKIPL REEINT
HALT ;FOR DEBUGGING, THIS SHOULD NOT HAPPEN UNLESS
;CODE IS NOT PAIRED CORRECTLY
; (DISINT[DALINT]/REAINT)
SKIPG REENOP
POPJ P,
MOVEM T,REESVT ;WE NEED AT LEAST ONE AC
MOVE T,INTPDL ;USE T AS THE INTPDL
ADD T,R70+10 ;WE MUST RESERVE THE SPACE WE WILL NEED
MOVEM T,INTPDL
SUB T,R70+5 ;BUT LEAVE 4 DUMMY WORDS + 1 FOR PC
POP P,(T) ;PC IS THAT WHICH WE WILL POPJ TO
JRST REETR1
;INTERRUPT HANDLING ROUTINES (DISPATCHED TO VIA SAIDSP)
INTERR: OUTSTR [ASCIZ\AN ILLEGAL INTERRUPT HAS BEEN RECIEVED. THIS IS AN
INTERNAL LISP ERROR\]
HALT
PARINT: MOVSI R,(%PIPAR) ;FLAG THAT IS PARITY ERROR
JRST SAIMER
NXMINT: SKIPA R,[%PIMPV]
ILMINT: MOVSI R,(%PIWRO)
SAIMER: MOVE F,INTPDL ;INT PDL POINTER INTO F
MOVEM R,IPSWD1(F) ;STORE WHERE MEMERR CAN FIND BITS
JRST MEMERR ;PROCESS MEMORY ERROR
;HERE FOR <ESC>I INTERRUPT
EYEINT: MOVE F,INTPDL ;INT PDL POINTER INTO F
SETZB R,IPSWD2(F) ;FORCE EXTERNAL CALL
; MOVM R,IPSWD2(F) ;GET <ESC>I ARG (POSITIVE FORM ONLY)
; CAILE R,177 ;ONLY CHARACTERS UP TO 177 HAVE MEANING
; TDZA R,R ;FORCE R TO ZERO
; TLO R,400000 ;FLAG THAT THIS IS AN INTERNAL CALL
; MOVEM R,IPSWD2(F) ;RESTORE ARGUMENT TO CHNINT
CLRBFI
JRST CHNINT ;FUDGE THE CHANNEL INTERRUPT
;NEW INTERRUPT MASK BITS, INDEXED BY CURRENT INTERRUPT NUMBER
SAIIMS: 0 ? 0 ? 0 ? 0
SA$ INTPOV ;MAIL INTERRUPT
SA% 0
0 ? 0 ? 0 ;NOT CURRENTLY ENABLED AT ANY TIME
INTPOV ;PAR ERROR: ONLY ALLOW PDL OV
-INTCLK-1 ;CLOCK INT: ALLOW ALL OTHERS
0 ? 0 ? 0 ? 0 ;NOT USED, IMP INTERRUPTS
-<INTCLK\INTTTI>-1 ;<ESC>I: ALL EXCEPT <ESC>I AND CLOCK
0 ;CHANGING QUEUES, NOT USED
INTPOV\INTILM\INTNXM\INTPAR\INTPOV ;PDL OV: ALL MEMORY ERRS AND PDL OV
0 ;PDP-11 INT, NOT USED
INTPOV ;ILM: ONLY PDL OV
INTPOV ;NXM: ONLY PDL OV
0 ? 0 ? 0 ;OVERFLOW AND OLD CLOCK TICK
;DISPATCH TABLE, INDEXED BY INTERRUPT NUMBER
SAIDSP:
SA% REPEAT 11,INTERR ;INTERRUPT ERROR, THIS CANNOT HAPPEN
SA$ REPEAT 4,INTERR
SA$ MAIINT ;MAIL INTERRUPT
SA$ REPEAT 4,INTERR
PARINT ;PARITY ERROR
CLOCKI ;CLOCK INTERRUPT
INTERR ? INTERR ? INTERR ? INTERR ;VARIOUS IMP INTERRUPTS
EYEINT ;<ESC>I INTERRUPT
INTERR ? INTERR ? INTERR ;CHANGING QUEUES, UNUSED, UNUSED
PDLOV ;PDL OV
INTERR ? INTERR ;PDP-11 INTERRUPT, UNUSED
ILMINT ;ILL MEM REF
NXMINT ;NON-EXISTANT MEMORY
INTERR ? INTERR ? INTERR ;UNUSED, UNUSED, OLD CLOCK INT
INTERR ? INTERR ;UNUSED
INTERR ;FLOATING OVERFLOW
INTERR ? INTERR ;UNUSED
INTERR ;INTEGER OVERFLOW
REPEAT 4, INTERR ;UNUSED
] ;END IFN SAIL
;ENBINT REAINT REAIN2 REAIN1 DISINT DALINT APRTRP $PDLOV DSMINT UCHINT REETRP REETR1
IFN D10*<SAIL-1>,[
SUBTTL DEC-10 ONLY NEWIO INTERRUPT CODE
;***A NOTE OF CAUTION
;WHENEVER THE INTPDL IS TOUCHED, IT IS DONE SO IN A CERTAIN ORDER OF
;INSTRUCTIONS. THIS IS NECESSARY TO PREVENT TIMING ERRORS FROM SCREWING
;UP THE PDL SLOT ALLOCATION (THIS PREVENTS SAVED AC'S, FOR EXAMPLE, TO
;BE OVERWRITTEN BY NESTED INTERRUPTS). DO NOT CHANGE ANY ORDERING OF
;THIS CODE WITHOUT METICULOUS CHECKING TO SEE THAT RANDOM, ASYNCHRONOUS
;INTERRUPTS WILL NOT CAUSE TOTAL LOSSAGE.
;INTERRUPT ENABLING/DISABLING
;ENABLE NORMAL INTERRUPTS, CALLED AT STARTUP
ENBINT: MOVEI T,REETRP ;REENTER TRAP ADR
MOVEM T,.JBREN
MOVEI T,APRTRP ;THIS LOCATION FOR ALL APR TRAPS
MOVEM T,.JBAPR ;INFORM TOPS-10 VIA JOBDAT
MOVEI T,STDMSK
MOVEM T,IMASK ;THIS IS CURRENT INTERRUPT MASK
MOVEM T,OIMASK ;ALSO IS OLD INTERRUPT MASK
SETOM REEINT ;REENTER INTERRUPTS ARE OK
SETOM REENOP ;BUT MUST SET BOTH FLAGS
SETZM INTALL ;WE HAVEN'T DISABLED ALL INTERRUPTS
APRENB T,
POPJ P, ;NO OTHER TRAPS VIA THIS MECHANISM
;RE-ENABLE AFTER DISABLE INTERRUPTS
REAINT: PUSH FXP,T
AOSE INTALL ;DISABLED ALL INTS?
SKIPA T,OIMASK ;NO, USE OLD INTERRUPT MASK
SKIPA T,IMASK ;ELSE USE CURRENT MASK
MOVEM T,IMASK ;THIS IS NOW THE CURRENT MASK
APRENB T,
SKIPLE REENOP
JRST REAIN2
SKIPG REEINT
JRST REAIN1
REAIN2: MOVEI T,CPOPJ
MOVEM T,.JBOPC
POP FXP,T
JRST REETR1 ;FUDGE A REENTER IF ONE WAS REQUESTED
REAIN1: SETOM REEINT
SETOM REENOP
POP FXP,T
POPJ P,
;DISABLE ALL BUT IMPORTANT INTERRUPTS
DISINT: PUSH FXP,T
MOVE T,IMASK ;GET CURRENT MASK
MOVEM T,OIMASK ;REMEMBER IT FOR RESETING PURPOSES
ANDI T,AP.POV ;ONLY ALLOW IMPORTANT INTERRUPTS
MOVEM T,IMASK ;THIS IS CURRENT STATE OF SYSTEM
SETZM REEINT ;NO REENTER'S NOW
APRENB T,
POP FXP,T
POPJ P,
;DISABLE ALL INTERRUPTS
DALINT: PUSH FXP,T
SETOM INTALL ;HAVE DISABLED ALL INTERRUPTS
SETZB T,REEINT
APRENB T,
POP FXP,T
POPJ P,
;APR TRAP HANDLING
APRTRP: SETZM REENOP ;ABSOLUTLY NO ↑C/REENTER INTERRUPTS NOW!
MOVEM T,APRSVT
SETZ T,
APRENB T, ;NO INTERRUPTS DURING TRAP SETUP
MOVE T,INTPDL ;USE T AS THE INTPDL
REPEAT 4, PUSH T, ;2 INTERRUPT WORDS AND 2 DEFFERED WORDS
PUSH T,.JBTPC ;INTERRUPT PC
PUSH T,D ;SAVE AC'S AS ITS INTERRUPT WOULD DO
PUSH T,R
PUSH T,F
MOVEM T,INTPDL
MOVE D,IMASK ;THIS IS GOING TO GO IN INT MASK1 WORD
MOVEM D,IPSDF1(T)
SETZ D,
MOVE F,.JBCNI ;GET ACTUAL PROCESSOR BITS
TRNE F,AP.PAR
TLO D,(%PIPAR) ;PARITY ERROR
TRNE F,AP.POV ;PDL OV?
JRST $PDLOV
TRNE F,AP.ILM ;PURE PAGE ERROR? (SHOULD THIS BE MPV?)
TLO D,(%PIWRO)
TRNE F,AP.NXM ;NON-EXISTANT MEMORY
TRO D,%PIMPV
MOVEM D,IPSWD1(T)
MOVE T,APRSVT
JUMPN D,MEMERR
OUTSTR [ASCIZ \UNRECOGNIZED APR INTERRUPT\]
HALT
$PDLOV: MOVE T,APRSVT
JRST PDLOV
;DISMISS AN INTERRUPT
DSMINT: PUSH FXP,T
MOVE T,INTPDL
MOVE F,IPSDF1(T) ;RESTORE APR FLAGS TO THOSE AT INTERRUPT TIME
MOVEM F,IMASK
APRENB F,
POP T,F
POP T,R
POP T,D
PUSH P,(T) ;RETURN PC
POPI T,5
MOVEM T,INTPDL ;RESTORE INTPDL
POP FXP,T
SKIPL REEINT
HALT ;FOR DEBUGGING, THIS SHOULD NOT HAPPEN UNLESS
;CODE IS NOT PAIRED CORRECTLY (DISINT[DALINT]/REAINT)
SKIPG REENOP
POPJ P,
MOVEM T,REESVT ;WE NEED AT LEAST ONE AC
MOVE T,INTPDL ;USE T AS THE INTPDL
ADD T,R70+10 ;WE MUST RESERVE THE SPACE WE WILL NEED
MOVEM T,INTPDL
SUB T,R70+5 ;BUT LEAVE 4 DUMMY WORDS + 1 FOR PC
POP P,(T) ;PC IS THAT WHICH WE WILL POPJ TO
JRST REETR1
];END IFN D10*<SAIL-1>
;THE FOLLOWING CODE IS FOR TOPS-10 AND SAIL
IFN D10,[
;HERE FOR A USER CHARACTER INTERRUPT, MAKE AN INTSTACK FRAME AND CALL CHNINT
UCHINT: SETZM REEINT ;DON'T ALLOW ↑C/REENTERS TO GO THROUGH
MOVEM T,REESVT ;WE NEED AT LEAST ONE AC
MOVE T,INTPDL ;USE T AS THE INTPDL
ADD T,R70+10 ;MUST SET INTPDL TO AFTER ITS REAL USE SO THAT
;RECURSIVE INTERRUPTS USE DIFFERENT STACK AREAS
MOVEM T,INTPDL
SUB T,R70+4 ;WE WILL KEEP A DUMMY FOUR WORDS
PUSH T,[0,,CPOPJ] ;PC FLAGS 0 AS THEY MAY GET RESTORED BY JRST 2,
PUSH T,D ;SAVE AC'S AS ITS INTERRUPT WOULD DO
PUSH T,R
PUSH T,F
MOVEM D,IPSWD2(T)
MOVE D,IMASK ;PUT OLD IMASK IN WORD 1 MASK
MOVEM D,IPSDF1(T)
MOVE T,REESVT
SETOM REENOP
SETOM REEINT
JRST CHNINT
;REENTER TRAP ADR
REETRP: AOSG REENOP
AOSLE REEINT ;REENTER ALLOWED?
JRSTF @.JBOPC ;NOPE, FLAG AND GO ON
MOVEM T,REESVT ;WE NEED AT LEAST ONE AC
MOVE T,INTPDL ;USE T AS THE INTPDL
ADD T,R70+10 ;MUST SET INTPDL TO AFTER ITS REAL USE SO THAT
;RECURSIVE INTERRUPTS USE DIFFERENT STACK AREAS
MOVEM T,INTPDL
SUB T,R70+4 ;WE WILL KEEP A DUMMY FOUR WORDS
PUSH T,.JBOPC ;INTERRUPT PC
REETR1: PUSH T,D ;SAVE AC'S AS ITS INTERRUPT WOULD DO
PUSH T,R
PUSH T,F
SETZM IPSWD2(T) ;FORCE MASK TO ZERO AS IS USED SPECIALLY
MOVE D,IMASK ;STORE IMASK AS WORD1 MASK
MOVEM D,IPSDF1(T)
MOVE T,REESVT
SETOM REENOP
SETOM REEINT
JRST CHNINT
] ;END IFN D10
;INTXIT INTXT2 INTXT9 INTLOS INTLS1 INTLS9 XUINT XUINT9
;;; WHEN THE INTERRUPT OCCURS, ACS D, R, AND F HAVE BEEN SAVED.
;;; BY CONVENTION AN INTERRUPT HANDLER MOVES THE INTPDL POINTER
;;; INTO F, GETS A VALID FXP POINTER INTO FXP, AND PUSHES THE OLD
;;; CONTENTS OF FXP ONTO THAT PDL.
;;; STANDARD INTERRUPT EXIT
;;; WILL RESTORE FXP AND D+R+F, AND DISMISS THE INTERRUPT.
INTXIT: MOVE FXP,(FXP) ;POP FXP,FXP
SKIPN NOQUIT ;CHECK FOR USER INTS STACKED BY INT HANDLER
SKIPN INTFLG .SEE CHECKI
JRST INTXT2
SKIPE GCFXP ;HOW CAN GCFXP BE NON-ZERO WITH NOQUIT ZERO?
.LOSE
PUSH FXP,IPSD(F) ;ARRANGE TO RESTORE D AND THE PC
PUSH P,IPSPC(F) ; (INCLUDING FLAGS!) AFTER CHECKING
PUSH P,CPXDFLJ ; FOR STACKED INTERRUPTS
MOVEI R,CKI0
MOVEM R,IPSPC(F)
INTXT2:
IFN D20+D10, JRST DSMINT ;DISMISS THE INTERRUPT
IFN ITS,[.CALL INTXT9 ;RETURN PC IS ON TOP OF INTPDL,
.LOSE 1000 ; AND ALSO THE OLD DEFER WORDS
INTXT9: SETZ
SIXBIT \DISMIS\ ;DISMISS INTERRUPT
5000,,D←6+3 ;POP ACS D, R, AND F FIRST
400000,,INTPDL ;INTERRUPT STACK POINTER
] ;END IFN ITS
;;; STANDARD LOSING INTERRUPT EXIT
;;; RESTORES FXP, AND D+R+F AS INTXIT DOES.
;;; ALSO EXPECTS A .LOSE ERROR CODE IN R.
INTLOS: MOVE FXP,(FXP) ;POP FXP,FXP
INTLS1:
IFN D10+D20, JRST DSMINT ;DISMISS THE INTERRUPT
IFN ITS,[.CALL INTLS9
.LOSE 1000
INTLS9: SETZ
SIXBIT \DISMIS\ ;DISMISS INTERRUPT
5000,,D←6+3 ;POP ACS D, R, AND F FIRST
,,INTPDL ;INTERRUPT STACK POINTER
,,IPSPC(F) ;NEW PC ;IN ORDER TO SPECIFY
,,IPSDF1(F) ;NEW .DF1 ; THE .LOSE CODE, ONE
,,IPSDF2(F) ;NEW .DF2 ; MUST MENTION ALL THIS TOO
400000,,R ;.LOSE ERROR CODE
] ;END IFN ITS
;;; EXIT INTERRUPT, GOING TO USER INTERRUPT HANDLER.
;;; ARGUMENT FOR THE UINT ROUTINE IS IN D.
;;; PDLS ARE IN GOOD SHAPE BY NOW, OF COURSE.
XUINT: SKIPE GCFXP ;BE EXTRA SURE ABOUT THE
IT$ .LOSE ; GOODNESS OF THE PDLS!
IFN <D10+D20>, HALT
;;;; POP FXP,FXP ;AT THIS POINT SHOULD BE SAME AS SUB FXP,R70+1
MOVE FXP,(FXP)
PUSH P,IPSPC(F) ;PUSH INTERRUPT PC ON STACK FOR UINT
PUSH P,CPXDFLJ ;ARRANGE FOR AC D AND FLAGS TO BE RESTORED
PUSH FXP,IPSD(F) ;PUSH AC D (BEFORE INTERRUPT) ON FXP
MOVEM D,IPSD(F) ;CAUSE D TO SURVIVE THE DISMIS
IFN D10+D20,[
MOVEI D,UINT ;NEW PC
MOVEM D,IPSPC(F) ;STORE WHERE OLD PC WENT
JRST DSMINT ;THEN DISMISS THE INTERRUPT
] ;END IFN D10+D20
IFN ITS,[.CALL XUINT9
.LOSE 1000
XUINT9: SETZ
SIXBIT \DISMIS\ ;DISMISS INTERRUPT
5000,,D←6+3 ;POP ACS D, R, AND F FIRST
,,INTPDL ;INTERRUPT STACK POINTER
1000,,UINT ;NEW PC
,,TTYDF1 ;NEW .DF1
400000,,TTYDF2 ;NEW .DF2
] ;END IFN ITS
;MEMERR MPVERR PURERR ILOPER ILOPR1 PARERR MEMER5 MEMER7 MEMER8 UIMPAR UIMILO UIMWRO UIMMPV $XLOST $XLOSE MEMER8 UIMPAR UIMILO UIMWRO UIMMPV IOCERR IOCERA IOCER8 IOCER9
;;; MEMORY AND OPCODE ERRORS: PARITY, PURE, MPV, ILOP.
;;; ASSUME NO MORE THAN ONE HAPPENS AT A TIME.
MEMERR:
IT$ .SUSET [.RJPC,,JPCSAV]
MOVE F,INTPDL
MOVE D,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,D
MOVN R,IPSWD1(F) ;THIS SEQUENCE KILLS THE LOW-ORDER
ANDCA R,IPSWD1(F) ; BIT FROM THE INTERRUPT WORD
; FOR D10, WILL CONTAIN APR FLAGS OF MERIT
SKIPE R ;LOSE IF MORE THAN ONE BIT WAS SET
IT$ .LOSE
IFN D10+D20, HALT
MOVE R,IPSWD1(F)
HRRZ D,IPSPC(F)
IT$ CAIN D,THIRTY+5 ;DDT DOES ≠X IN LOCATION 34
IT$ JRST $XLOSE
TLNE R,(%PI<PAR>) ;WAS IT A PARITY ERROR?
JRST PARERR
TLNE R,(%PI<WRO>) ;WRITE INTO READ-ONLY?
JRST PURPGI
TRNE R,%PI<ILO> ;ILLEGAL OPERATION?
JRST ILOPER
TRNN R,%PI<MPV> ;MEMORY PROTECT VIOLATION?
.VALUE ;NO??? WHAT HAPPENED???
CAIE D,UBD1 ;LET SPECPDL RESTORATION HAPPEN
JRST MPVERR ; EVEN IF ONE SLOT GOT CLOBBERED
AOS IPSPC(F) ;BUMP PC PAST OFFENDING INSTRUCTION
JRST INTXIT
MPVERR: SKIPA D,[UIMMPV]
PURERR: MOVEI D,UIMWRO
JRST MEMER5
ILOPER:
IFN D20,[
SKIPN TENEXP
JRST ILOPR1
; THIS A CRUFTY BUT ADEQUATE THEORY OF ERJMP'S
HLRZ R,0(D)
CAIE R,320700 ;ERJUMP?
JRST ILOPR1
HLRZ R,-1(D)
CAIE R,104000 ;JSYS?
JRST ILOPR1
HRRZ R,0(D)
HRRM R,IPSPC(F) ;CLOBBER RESTART ADDRESS
JRST INTXIT
ILOPR1:
] ;END IFN D20
SKIPA D,[UIMILO]
PARERR: MOVEI D,UIMPAR
MEMER5: HRRZ R,INTPDL ;MACHINE ERROR! WHAT TO DO?
CAIN R,INTPDL+LIPSAV ;IF THE ERROR HAPPENED WITHIN AN INTERRUPT SERVER,
SKIPN VMERR ; OR IF USER SUPPLIED NO ERROR FUNCTION,
JRST MEMER7 ; CRAP OUT BACK TO DDT
MOVEI D,100000(D)
HRL D,IPSPC(F)
PUSHJ FXP,$IWAIT
JRST XUINT ;CALL USER INTERRUPT HANDLER
; JRST INTXIT ;MAY RE-DO LOSING INSTR, BUT SO WHAT?
; THAT'S A FEATURE, NOT A BUG.
ANDI D,777
MEMER7:
IFN ITS,[
HRRZ R,MEMER8(D)
JRST INTLOS
MEMER8:
OFFSET -.
UIMPAR:: 1+.LZ %PIPAR
UIMILO:: 1+.LZ %PIILO
UIMWRO:: 1+.LZ %PIWRO
UIMMPV:: 1+.LZ %PIMPV
OFFSET 0
$XLOST: .VALUE [ASCIZ \:≠ YOUR ≠↔≠⊗X LOST ≠↔PROCEED⊗ \]
JRST THIRTY+5 ;LET THE ≠X RETURN CORRECTLY
$XLOSE: MOVEI R,$XLOST ;CAUSE INTERRUPT DURING AN ≠X
MOVEM R,IPSPC(F) ; TO GO TO $XLOST (CROCK)
JRST INTXIT
] ;END IFN ITS
IFE ITS,[
MOVEI A,MEMER8(D) ;TRANSFER TO ONE OF THE LER3'S BELOW
EXCH A,IPSPC(F)
ANDI A,-1
JRST INTXIT
MEMER8:
OFFSET -.
UIMPAR:: LER3 [SIXBIT \PC AT WHICH MEMORY PARITY ERROR OCCURRED!\]
UIMILO:: LER3 [SIXBIT \PC WITH ILLEGAL INSTRUCTION CODE!\]
UIMWRO:: LER3 [SIXBIT \PC AT WHICH ATTEMPT TO WRITE INTO PURE PAGE!\]
UIMMPV:: LER3 [SIXBIT \PC WITH MEMORY PROTECTION VIOLATION!\]
OFFSET 0
] ;END OF IFE ITS
;;; IFN D10,[
;;; OUTSTR @MEMER8(D) ;GIVE ERROR IF USER DOESN'T WANT IT
;;; EXIT 1,
;;; JRST .-2
;;; ] ;END IFN D10
;;;
;;; IFN D20,[
;;; HRRO 1,MEMER8(D) ;GIVE ERROR
;;; PSOUT
;;; HALTF ;THEN STOP EXECUTION NICELY
;;; ] ;END IFN D20
;;;
;;; IFN D10+D20,[
;;; MEMER8:
;;; OFFSET -.
;;; UIMPAR::[ASCIZ \?Parity error in job
;;; \]
;;; UIMILO::[ASCIZ \?Illegal op executed
;;; \]
;;; UIMWRO::[ASCIZ \?Write into read-only memory
;;; \]
;;; UIMMPV::[ASCIZ \?Memory protection violation
;;; \]
;;; OFFSET 0
;;; ] ;END IFN D10+D20
;;; I/O CHANNEL ERROR HANDLER
IFN ITS,[
IOCERR: MOVE F,INTPDL
MOVE R,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,R
.SUSET [.RBCHN,,R]
SKIPN R
JRST IOCER8
.CALL SCSTAT
.LOSE 1400
LSH D,-33
HRRZ R,IPSPC(F)
MACROLOOP NIOCTR,ZZI,* ;ZZI MACROS DEFINE IOC TRAPS
SKIPL R
JRST IOCER8
IOCERA: HRRM R,IPSPC(F) ;CLOBBER RETURN PC
HLRZ R,R
CAIN R,400000+D ;WANT TO STICK IOC ERROR
MOVEI R,400000+IPSD(F) ; CODE INTO SPECIFIED AC,
CAIN R,400000+R ; BUT MUST BEWARE OF D AND R
MOVEI R,400000+IPSR(F)
MOVEM D,-400000(R)
JRST INTXIT
IOCER8: SKIPN IOCINS ;ANY USER IOC ERROR HANDLER?
JRST IOCER9 ;NOPE, LET DUPERIOR HAVE THE ERROR
MOVE R,IPSPC(F) ;PC IN R
;ERROR CODE IN D (SEE ABOVE)
;CALL USER WITH PC IN R AND ERROR CODE IN D.
;THE USER'S ROUTINE MUST NOT MUNG ANY AC'S OTHER THAN R AND D, THOUGH THE
;STACKS MAY BE USED. IF THE USER'S INSTRUCTION SKIPS, THE RIGHT
;HALF OF R CONTAINS THE PC TO DISPATCH TO AFTER THE DISMIS, AND THE LEFT HALF
;OF R CONTAINS 400000+<ADR IN WHICH TO STORE ERROR CODE>
PUSHJ FLP,@IOCINS
SKIPA
JRST IOCERA
IOCER9: MOVEI R,1+.LZ %PIIOC
JRST INTLOS
] ;END IFN ITS
;CHNINT CHNI1H CHNIZ TTYI1 CHNI2
;;; INTERRUPT FROM I/O CHANNEL.
;;; PRESENTLY ONLY TWO KINDS ARE HANDLED:
;;; TTY INPUT: INTERRUPT CHAR TYPED.
;;; TTY OUTPUT: **MORE**.
CHNINT: MOVE F,INTPDL
MOVE D,IPSWD2(F) ;GET WORD TWO INTERRUPT BITS
MOVE R,FXP ;FXP MAY BE IN A BAD STATE IF
SKIPE GCFXP ; WITHIN GC, SO RESTORE IT AND
MOVE FXP,GCFXP ; THEN PUSH ITS OLD VALUE
PUSH FXP,R ;REMEMBER, PDL OVERFLOW ISN'T DEFERRED NOW
IFN ITS,[
MOVN R,D
AND R,D ;R GETS LOWEST SET BIT
ANDCM D,R ;D GETS ALL OTHER BITS
SKIPE D
.SUSET [.SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
MOVE D,R
JFFO D,.+1 ;FIND CHANNEL NUMBER
MOVNS R ; FOR SOME PENDING
ADDI R,43 ; INTERRUPT BIT
PUSH FXP,R ;SAVE CHANNEL NUMBER
SKIPN R ;CHANNEL 0 ??
JRST CHNI2 ;YES, THIS CAN HAPPEN IN STRANGE CASES
SKIPN CHNTB(R) ;UNOPEN DEVICE ??
.VALUE ;BUT DON'T ALLOW INTERRUPTS FROM CLOSED CHAN
CHNI1H: .CALL SCSTAT ;GET STATUS FOR THE CHANNEL
.VALUE
ANDI D,77 ;GET ITS INTERNAL PHYSICAL DEVICE TYPE
SKIPE D
CAILE D,2
JRST CHNI5
];END IFN ITS
IFN D10+D20,[
MOVE R,D
PUSH FXP,V%TYI ;SAR ADR ON STACK
] ;END IFN D10+D20
IFN ITS,[
HRRZ D,CHNTB(R)
MOVE D,TTSAR(D)
TLNE D,TTS<TY> ;IF IT'S NOT A TTY INPUT ARRAY, WE DON'T
TLNE D,TTS<IO> ;HAVE INTERRUPT CHAR DISPATCH TABLE
JRST CHNI5 ; SO JUST TREAT AS ENDPGFUN (I.E. RANDOM CHANL)
.ITYIC R, ;TYPE 0 IS TTY INPUT
JRST CHNI8 ;TIMING ERROR OR SOMETHING - IGNORE
] ;END IFN ITS
IFN D10,[
TRNE R,400000 ;IF NOT INTERNAL GET FROM USE
JRST CHNIZ ;ELSE WE HAVE ALREADY
OUTCHR ["?]
INCHRW R
SA$ TRO R,%TXCTL ;CONTROLLIFY THE CHARACTER
CHNIZ:
] ;END IFN D10
SA% IFN D10+D20, ANDI R,37 ;MAP ALL CHARS INTO CTRL CHARACTERS
SA$ ANDI R,777
PUSH FXP,R ;SAVE INTERRUPT CHARACTER
PUSH FXP,TT ; AND ALSO TT
HRRZ TT,-2(FXP) ;FETCH CHANNEL NUMBER
;FOR D-10, THIS IS ADR OF SAR
TTYI1:
IT$ HRRZ TT,CHNTB(TT)
HRRZ TT,TTSAR(TT)
IFN D10+D20,[
HRL TT,F.CHAN(TT) ;NOW GET CHANNEL #
HLRZM TT,-2(FXP) ;MAKE THE CHANNEL NUMBER CORRECT ON THE STACK
] ;END IFN D10+D20
JSP D,TTYICH ;GET BACK INTERRUPT FN IN R
POP FXP,TT
JUMPE R,CHNI2 ;NULL FUNCTION - IGNORE
MOVEI D,(R)
LSH D,-SEGLOG
MOVE D,ST(D)
TLNN D,FX
JRST CHNI4
MOVE R,(R) ;"FUNCTION" IS A FIXNUM
IFN ITS+SAIL,[
MOVEI D,(R) ;IF ANY OF THE SUPRA-ASCII
ANDCM D,(FXP) ; MODIFIER BITS ARE SET IN THE
MOVSS (FXP) ; "FUNCTION", INSIST THAT THE
ANDM R,(FXP) ; CORRESPONDING BITS APPEAR IN
MOVSS (FXP) ; THE CHARACTER TYPED. SIMILARLY,
IOR D,(FXP) ; THE SAME BITS SET IN THE LEFT HALF
TRNE D,%TX<MTA+CTL+TOP+SFT+SFL> ; MEAN THAT THOSE BITS MUST BE OFF.
JRST CHNI2
] ;END IFN ITS+SAIL
ANDI R,177
MOVEI D,TRUTH ;MOOOOBY SKIP CHAIN OF SYSTEM INTS
CAIN R,↑A ;↑A (SETQ ↑A T)
HRRZM D,SIGNAL
CAIN R,↑C ;↑C (SETQ ↑D NIL)
SETZM GCGAGV
CAIN R,↑D ;↑D (SETQ ↑D T)
HRRZM D,GCGAGV
CAIN R,↑G ;↑G (↑G) ;QUIT
JRST CN.G
CAIN R,↑R ;↑R (SETQ ↑R T)
HRRZM D,TAPWRT
CAIN R,↑T ;↑T (SETQ ↑R NIL)
SETZM TAPWRT
CAIN R,↑V ;↑V (SETQ ↑W NIL)
SETZM TTYOFF
CAIN R,↑W ;↑W (PROG2 (SETQ ↑W T)
JRST CN.W ; (CLEAR-OUTPUT T))
CAIN R,↑X ;↑X (ERROR 'QUIT) ;↑X QUIT
JRST CN.X
CAIN R,↑Z ;↑Z CRAP OUT TO DDT
JRST CN.Z
CHNI2: SUB FXP,R70+2
JRST INTXIT
;CHNI4 CHNI4A CHNI5 CHNI8 CHNI4C CHNI4H
CHNI4: POP FXP,D ;REAL LIVE USER INTERRUPT FUNCTION
TRO D,400000 ;2.9 => TTY INPUT INTERRUPT CHAR
CHNI4A: POP FXP,R
HRL D,CHNTB(R)
SKIPE UNREAL
JSP R,CHNI4C ;BARF! (NOINTERRUPT 'TTY) OR (NOINTERRUPT T)
PUSHJ FXP,$IWAIT ;CALLS UISTAK AND SKIPS IF IN GC
JRST XUINT ;RUNS USER INTERRUPT
JRST INTXIT
IFN ITS,[
CHNI5: HRRZ D,CHNTB(R) ;CHECK OUT FILE ARRAY
HRRZ D,TTSAR(D)
SKIPN FO.EOP(D) ;SKIP IF ENDPAGEFN
JRST CHNI8
MOVEI D,200000+<2*FO.EOP+1> ;2.8 => RANDOM FILE INTERRUPT
JRST CHNI4A ;**MORE** => ENDPAGEFN GETS RUN
CHNI8: SUB FXP,R70+1
JRST INTXIT
];END IFN ITS
;;; ROUTINE TO STACK UP INTERRUPT IN INTAR -- USED BY CHNINT, JOBINT, AND FNYINT
CHNI4C: MOVE F,UNREAR ;STACK UP INTERRUPT IN THE
CAIL F,LUNREAR ; NOINTERRUPT QUEUE
JRST TMDAMI ;OOPS! TOO MANY DAMN INTERRUPTS!
MOVE F,[400000+LUNREAR-1,,UNREAR+LUNREAR-2]
CHNI4H: POP F,1(F)
TLNE F,377777
JRST CHNI4H
MOVEM D,UNREAR+1
AOS UNREAR
HRRZ F,INTPDL
JRST 2(R)
;JOBINT TTYICH TTYIC1
; COMMENT FOR @ CHANGE
IFN JOBQIO,[
;;; INTERRUPT FROM INFERIOR PROCEDURE(S)
JOBINT: MOVE F,INTPDL
MOVE D,IPSWD2(F)
MOVE R,FXP
SKIPE GCFXP ;IF IN GC, FXP MAY BE
MOVE FXP,GCFXP ; SCREWED UP
PUSH FXP,R
MOVN R,D
AND R,D ;R GETS LOWEST SET BIT
ANDCM D,R ;D GETS ALL OTHER BITS
SKIPE D
.SUSET [.SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
MOVE D,R
JFFO D,.+1
MOVNS R ;-22 < R < -11
SKIPN D,JOBTB+21(R)
.VALUE ;NO JOB ARRAY???
HRRZ R,TTSAR(D)
SKIPN J.INTF(R)
JRST INTXIT ;NO INTERRUPT FUNCTION - IGNORE INTERRUPT
MOVSI D,(D)
TRO D,200000+<2*J.INTF+1>
SKIPGE UNREAL
JSP R,CHNI4C ;GORP! (NOINTERRUPT T)
PUSHJ FXP,$IWAIT
JRST XUINT
JRST INTXIT
] ;END OF IFN JOBINT
;;; TTSAR OF TTY INPUT FILE ARRAY IN TT.
;;; INPUT INTERRUPT CHARACTER IN R.
;;; RETURN ADDRESS IN D.
;;; RETURNS INTERRUPT FUNCTION IN R.
TTYICH:
IT$ TRZ R,%TX<TOP+SFL+SFT+MTA> ;FOLD 12.-BIT CHAR
SA$ ANDI R,777
SA% TRZN R,%TX<CTL> ; DOWN TO 7 IF NECESSARY
SA% JRST TTYIC1
SA% CAIE R,177
SA% TRZ R,140
TTYIC1: ROT R,-1 ;CLEVER ARRAY ACCESS
ADDI TT,FB.BUF(R) ;INTERRUPT FNS ARE IN "BUFFER"
HLR R,(TT)
SKIPGE R
HRRZ R,(TT) ;SIGN BIT OF R GETS CLEARED
JRST (D)
;CN.W CN.W0 CN.Z CN.Z0 ALTP CN.Z ALTP CN.Z CKI2I CTRLG CN.X CN.G CN.G1
SUBTTL VARIOUS SYSTEM TTY INPUT CHAR INTERRUPT HANDLERS.
CN.W: HRRZM D,TTYOFF ;IMMEDIATE TTYOFF (↑W)
PUSH FXP,T
PUSH FXP,TT
HRRZ TT,V%TYO
MOVE T,ASAR(TT)
TLNN T,AS.FIL ;Is it a File Array?
JRST CN.W0 ; No, don't do it at all!
MOVE TT,TTSAR(TT)
TLNE TT,TTS<TY> ;IFF it's a TTY
PUSHJ FXP,CLRO3 ; ALSO DO (CLEAR-OUTPUT T)
CN.W0: POP FXP,TT
POP FXP,T
JRST CHNI2
IFN D20,[
CN.Z: PUSH FXP,T
PUSH FXP,TT
MOVEI T,CN.Z0 ;RETURN TO SUPERIOR (MAY BE IDDT)
MOVE TT,INTPDL
EXCH T,IPSPC(TT)
MOVEM T,CN.ZX
POP FXP,TT
POP FXP,T
JRST CHNI2 ;ALPT$G PROCEEDS
CN.Z0: HALTF
ALTP: JRST 2,@CN.ZX
] ;END IFN D20
IFN D10,[
CN.Z: SKIPE R,.JBDDT ;ANY DDT IN CORE?
JRST (R)
EXIT 1, ;RETURN TO MONITOR IF NO DDT, CONT CONTINUES
ALTP: JRST CHNI2 ;PROCEED ON ALTP$G
] ;END IFN D10
IFN ITS,[
CN.Z: PUSH FXP,TT ;WE NEED ONE AC TO HOLD CHANNEL NUMBER
HRRZ TT,-2(FXP)
.CALL CKI2I
.VALUE
POP FXP,TT
.VALUE [ASCIZ \:≠DDT≠
\]
JRST CHNI2
CKI2I: SETZ
SIXBIT \RESET\
400000,,TT
] ;END IFN ITS
CTRLG: HRROI D,-3 ;↑G - SUBR 0
PIPAUSE ;DISABLE THE INTERRUPT SYSTEM FOR NOW
SETZM UNREAR ;CLEAR OUT ALL STACKED INTERRUPTS
SETZM INTAR
HRREM D,INTFLG
SKIPE NOQUIT ;HOW CAN NOQUIT BE NON-ZERO?
IT$ .LOSE ; MAYBE THE USER SCREWED UP
IFN D10+D20, HALT
JRST CKI0 ;PROCESS THE FORCED QUIT
CN.X: SKIPA D,[-6] ;ERRSETABLE (↑X) QUIT
CN.G: HRROI D,-7 ;IMMEDIATE (↑G) QUIT
SKIPE UNREAL
JRST CN.G1
SETZM INTAR ;KILL ALL INTERRUPTS STACKED UP
HRREM D,INTFLG
PUSHJ FXP,$IWAIT
SKIPA D,[CKI0]
JRST CHNI2 ;CAN'T PROCESS QUIT NOW
MOVEM D,IPSPC(F) ;IF CAN QUIT NOW, ARRANGE FOR SERVER
JRST CHNI2 ; TO RETURN TO INTERRUPT CHECKER
CN.G1: SETZM UNREAR ;KILL STACKED UNREAL INTERRUPTS
EXCH D,UNRC.G ;ELSE STACK UP AN UNREAL
TRNE D,1 ; ↑G OR ↑X INTERRUPT
MOVEM D,UNRC.G ;DON'T LET A ↑X DISPLACE A ↑G
JRST CHNI2
;REALCLOCK RUNCLOCK RCLOK1 FNYINT FNYIN0 RCLOK2
IFN ITS,[
;;; REAL TIME ALARMCLOCK
REALCLOCK:
MOVSI R,400000 ;SHUT CLOCK BACK OFF
.REALT R,
MOVEI R,Q$TIME
JRST RCLOK1
;;; RUNTIME ALARMCLOCK
RUNCLOCK:
MOVEI R,Q$RUNTIME
RCLOK1: MOVE F,INTPDL
MOVE D,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,D
SKIPN VALARMCLOCK ;IGNORE IF THERE IS NO
JRST INTXIT ; ALARMCLOCK FUNCTION
MOVSI D,(R) ;TYPE 0, SUBTYPE 0 IS ALARMCLOCK
SKIPL UNREAL ;SKIP IF (NOINTERRUPT T)
JRST RCLOK2
MOVEM D,UNRRUN-Q$RUNTIME(R) ;STACK UP INTERRUPT
JRST INTXIT
IFN USELESS,[
FNYINT: MOVE F,INTPDL ;COMMON HANDLER FOR FUNNY INTERRUPTS
MOVE D,FXP
SKIPE GCFXP
MOVE FXP,GCFXP
PUSH FXP,D
MOVE R,(R)
SKIPN (R)
JRST INTXIT ;EXIT IF NO USER HANDLER
HLRZ D,R
CAIE D,UIFTTR ;SPECIAL HACK FOR TTY-RETURN
JRST FNYIN0
HRRZ R,IPSPC(F) ;GET PC OF INTERRUPT
CAIE R,TYICAL ;INTERRUPTED FROM CANONICAL INPUT WAIT?
CAIN R,TYICA1
HRLI D,Q$IN ;YES, ARG TO INT FUN IS 'IN
CAIN R,TYIXCT ;ANOTHER CANNONICAL PLACE
HRLI D,Q$IN
FNYIN0: SKIPGE UNREAL
JSP R,CHNI4C ;MUST STACK UP IF UNREAL
] ;END OF IFN USELESS
RCLOK2: PUSHJ FXP,$IWAIT ;WILL STACK AND SKIP IF GC
JRST XUINT ;GIVE USER CLOCK INTERRUPT
JRST INTXIT
;CLIINT TTRINT SYSINT MARINT
IFN USELESS,[
;;; CLI INTERRUPT HANDLER
CLIINT: JSP R,FNYINT
UIFCLI,,VCLI
;;; RETURN OF TTY TO THE JOB
TTRINT: JSP R,FNYINT
UIFTTR,,VTTR
;;; SYSTEM GOING DOWN OR BEING DEBUGGED
SYSINT: JSP R,FNYINT
UIFSYS,,VSYSD
;;; MAR BREAK
MARINT: MOVEI R,%PIMAR
ANDCAM R,IMASK
.SUSET [.SMASK,,IMASK]
.SUSET [.SMARA,,R70]
MOVEI R,1+.LZ %PIMAR
SKIPN VMAR
JRST INTLS1 ;IN CASE (STATUS MAR) GETS LOUSED UP
JSP R,FNYINT
UIFMAR,,VMAR
] ;END OF IFN USELESS
] ;END IFN ITS
;YESIN1 UISTK1 UISTK2 TMDAMI TMDAM2 QMARK
;;; STACK UP A USER INTERRUPT WHICH MUST BE DELAYED.
;;; ARGUMENT IS IN D AS FOR UINT; IT IS SAVED IN THE INTAR QUEUE.
;;; ASSUMES FREE USE OF ACCUMULATOR R.
;;; PI INTERRUPTS MUST BE DISABLED!!!!
.SEE PIOF
YESIN1: POP P,UISTAK ;THIS IS A HORRIBLE CROCK
;UISTAK: 0
UISTK1: MOVE R,INTFLG ;IF WE ARE ABOUT TO QUIT ANYWAY,
AOJL R,@UISTAK ; THEN FORGET THE WHOLE THING
AOS R,INTAR
CAILE R,LINTAR
JRST TMDAMI ;TOO MANY DAMN INTERRUPTS
MOVE R,[400000+LINTAR-1,,INTAR+LINTAR-2]
UISTK2: POP R,1(R)
TLNE R,377777
JRST UISTK2
MOVSM D,INTAR+1
SETOM INTFLG
JRST @UISTAK
TMDAMI: SKIPN GCFXP ;TOO MANY DAMN INTERRUPTS
JRST TMDAM2
IRP X,,[P,FLP,FXP,SP]
MOVE X,GC!X
TERMIN
TMDAM2:
; LERR [SIXBIT \TOO MANY DEFERRED INTERRUPTS!\]
IFN ITS,[
.VALUE [ASCIZ \:≠TOO MANY DEFERRED INTERRUPTS≠↔CONTIN⊗
\]
.LOSE
] ;END OF IFN ITS
10$ OUTSTR [ASCIZ \TOO MANY DEFERRED INTERRUPTS\]
10$ EXIT 1,
10$ JRST .-1
IFN D20,[
HRROI 1,[ASCIZ \
?Too many deffered interrupts
\]
HALTF
] ;END IFN D20
;QMARK -- THIS IS HERE SO BAKTRACE WILL FIND IT AS LAST SUBR (ARGG!!)
QMARK: MOVEI A,QM
POPJ P,
;PURPGI PPGI5A PPGI3 PPGI5 PPGI6
;;; PURE PAGE TRAP HANDLER
;;; COMES HERE WITH LOSING PC IN D.
.SEE MEMERR
PURPGI:
IFN D10*<1-SAIL>,[
SKIPE KA10P
SOSA D,IPSPC(F) ;MAKE PC POINT TO OFFENDING INSTRUCTION
SKIPA
ANDI D,-1
] ;END OF IFN D10*<1-SAIL>
CAIN D,STQPUR
JRST PPGI5
PPGI5A:
IFN PAGING,[
MACROLOOP NPURTR,ZZP,*, ;ZZP MACROS DEFINE WHAT PLACES HAVE HANDLERS
] ;END IFN PAGING
JUMPGE D,PURERR
PPGI3:
HRRM D,IPSPC(F)
JRST INTXIT
PPGI5: HRRZS A ;FORGET LEFT HALF
CAIN A,PWIOINT ;BINDING INTERRUPT INHIBITS: NORMAL PURTRAP
JRST PPGI5A
MOVEM A,STQLUZ ;REMEMBER WHICH VALUE CELL WE TRIED TO GRONK
MOVE D,[TIRPATE,,NIL]
MOVEM D,(SP)
SKIPE GCFXP
.VALUE
AOS IPSPC(F) ;DON'T RETRY THE LOSING INSTRUCTION!
PUSHJ FXP,$IWAIT ;LET SPDL GET CAUGHT UP
SKIPA T,STQLUZ ;ERROR HANDLER WANTS LOCATION IN T
JRST PURERR ;INTWAIT MAY SKIP
PPGI6: HRRZI D,NILSETQ ;TRIED TO PUT A VALUE PROPERTY ON NIL
JRST PPGI3
;UIMPAR UIMILO UIMWRO UIMMPV UIFCLI UIFMAR UIFTTR UIFSYS NUINT1 NUINT2
SUBTTL USER INTERRUPT ROUTINES
;;; USER INTERRUPT TYPES FOR NEWIO
;;;
;;; FORM OF ARGUMENT TO UINT (ALSO STORED IN THIS FORM
;;; IN INTAR, ONLY WITH HALVES SWAPPED; WHY, I DON'T KNOW):
;;;
;;; 4.9-3.1 ARGUMENT FOR INTERRUPT FUNCTION
;;; 2.9 IF 1, SPECIFIES A TTY INPUT CHARACTER INTERRUPT.
;;; ARGUMENT IS TTY INPUT FILE ARRAY.
;;; 2.8-2.4 MUST BE ZERO.
;;; 2.3-1.1 CHARACTER WHICH CAUSED INTERRUPT, AS
;;; READ BY .ITYIC. THIS MAY BE A 12.-BIT
;;; CHARACTER, AND SO MAY HAVE TO BE FOLDED
;;; BEFORE SELECTING THE INTERRUPT FUNCTION.
;;; THIS IS PASSED AS THE SECOND ARGUMENT.
;;; 2.8 IF 1, SPECIFIES AN INTERRUPT RELATED TO A FILE
;;; ARRAY OR SIMILAR OBJECT, E.G. THE **MORE**
;;; INTERRUPT FOR TTY OUTPUT.
;;; ARGUMENT IS THE FILE ARRAY.
;;; 2.7-1.1 IS THE INDEX OF THE INTERRUPT FUNCTION
;;; WITHIN THE ARRAY, WHERE THE LOW BIT SPECIFIES
;;; LEFT OR RIGHT HALF AS USUAL.
;;; 2.7 IF 1, SPECIFIES A MACHINE ERROR.
;;; THE ARGUMENT IS THE LOCATION OF THE LOSS.
;;; BITS 1.9-1.1 SPECIFY THE NATURE OF THE ERROR.
UIMPAR==:0 ;ODDP ;PARITY ERROR
UIMILO==:1 ;EVAL ;ILLEGAL OPERATION
UIMWRO==:2 ;DEPOSIT ;WRITE INTO READ-ONLY MEMORY
UIMMPV==:3 ;EXAMINE ;MEMORY PROTECT VIOLATION
;;; IF 2.9-2.7 ARE ZERO, THEN:
;;; 2.2-2.1 TYPE OF INTERRUPT
;;; 1.9-1.1 SPECIFIC INTERRUPT
;;; CURRENT TYPES AND SPECIFIC INTERRUPTS ARE:
;;; 0 RANDOM ASYNCHRONOUS (DELAYED BY (NOINTERRUPT T))
;;; 0 ALARMCLOCK
UIFCLI==:1 ;CLI-MESSAGE ;USELESS
UIFMAR==:2 ;MAR-BREAK ;USELESS
UIFTTR==:3 ;TTY-RETURN ;USELESS
UIFSYS==:4 ;SYS-DEATH ;USELESS
IFE USELESS, NUINT0==:1 .SEE GCP6Q6
IFN USELESS, NUINT0==:5 .SEE GCP6Q6
;;; 1 RANDOM SYNCHRONOUS
;;; 0 AUTOLOAD
;;; 1 ERRSET FN
;;; 2 *RSET-TRAP
;;; 3 GC-DAEMON
;;; 4 GC-OVERFLOW
;;; 5 PDL-OVERFLOW
NUINT1==:6 .SEE GCP6Q6
;;; 2 ERINT (SYNCHRONOUS)
;;; 0 UNDF-FNCTN
;;; 1 UNBND-VRBL
;;; 2 WRNG-TYPE-ARG
;;; 3 UNSEEN-GO-TAG
;;; 4 WRNG-NO-ARGS
;;; 5 GC-LOSSAGE
;;; 6 FAIL-ACT
;;; 7 IO-LOSSAGE
NUINT2==:10 .SEE GCP6Q6
;UINT UINTEX UINTX1 UINT2 UINT3 HHCTB UINTPU
;;; WE NORMALLY DON'T PUSHJ HERE AT ALL FROM PI LEVEL!
;; (THINK ABOUT HOW TO SIMPLIFY THE CODE HERE.)
UINT: PUSHJ P,UINTPU
SKIPN NOQUIT
SKIPE INHIBIT
JRST UINT2
SKIPGE INTFLG
JRST UINT3
PUSHJ P,UINT0
.SEE UINTPU ;PEOPLE COME HERE TO UNDO UINTPU
;NOTE: THE PUSH'S OF UINTPU MUST SYNC WITH THE POP'S HERE
UINTEX:
IFN <D10+D20>,[
POP FXP,OIMASK
POP FXP,IMASK
] ;END IFN <D10+D20>
SKIPL (FXP)
JRST UINTX1
PIONAGAIN
IT$ .SUSET [.SDF1,,R70]
IT$ .SUSET [.SDF2,,R70]
UINTX1: SUB FXP,R70+1 ;GET RID OF REENABLE INTERRUPTS FLAG
POP FXP,R .SEE UINTPU
JRST CHECKI ;PDL-OVERFLOW MAY HAVE BEEN STACKED
.SEE PDLOV
UINT2: JSR UISTAK ;DELAY A USER INTERRUPT, SINCE INHIBIT SWITCH IS ON
JRST UINTEX
UINT3: HRRZ D,INTFLG ;CHECK INTERRUPT FLAG TO SEE THAT IS SAYS "QUIT"
CAIE D,-1 ;AND NOT SOME INCONGRUOUS USER PI
JRST CKI2
HHCTB: .VALUE
; LERR EMS11 ;HOW THE HELL CAN THIS BE?
UINTPU: ;PUSH PI STATE, THEN DISABLE
PUSH FXP,R ;SAVE R FOR UISTAK, ETC.
PUSH FXP,T
IFE ITS,[
PUSH FXP,IMASK ;SAVE APRENB MASKS
PUSH FXP,OIMASK
MOVN T,INTALL ;GET PI STATE FROM INTERNAL WORD
EXCH T,-2(FXP)
SKIPGE -2(FXP)
PIPAUSE
] ;END IFE ITS
IFN ITS,[
.SUSET [.RPICLR,,T]
EXCH T,(FXP)
SKIPGE (FXP)
PIPAUSE
] ;END OF IFN ITS
POPJ P,
;YESINT UINT0 UIXPUSH UISWS UISAVT UIFRM UISAVA
;;; SAVE THE WORLD FOR A USER INTERRUPT, INVOKE IT, AND RESTORE.
;;;
;;; SAVED QUANTITIES INCLUDE ALL ACCUMULATORS, THE PDL POINTERS
;;; (FOR FRETURN), AND THE SUPER-WRITABLE STUFF (TEMPORARIES IN
;;; LOW CORE USED BY INTERRUPTABLE FUNCTIONS).
;;; MANY GLOBAL SWITCHES ARE BOUND AND RESET.
;;; FOR ASYNCHRONOUS USER INTERRUPTS, THE (NOINTERRUPT T) STATE
;;; MAY BE ENTERED; THE PREVIOUS NOINTERRUPT STATE IS SAVED.
;;; MUST NOT COME HERE WITHOUT FIRST USING THE $IWAIT
;;; ROUTINE TO DECIDE WHETHER OR NOT WE ARE IN GC.
;;; ALSO MUST CHECK THE NOINTERRUPT SWITCH BEFORE COMING HERE
;;; IF THAT IS RELEVANT TO THE PARTICULAR USER INTERRUPT.
;;; INTERRUPTS MUST BE TURNED OFF WITH PIOF BEFORE COMING HERE.
;;; THE WORD DESCRIBING THE USER INTERRUPT MUST BE IN D.
YESINT: SKIPN NOQUIT
SKIPE INHIBIT
JRST YESIN1
UINT0:
IT$ .SUSET [.SDF1,,TTYDF1] ;MUST ALLOW PDL OVERFLOW AND MEMORY
IT$ .SUSET [.SDF2,,TTYDF2] ; ERRORS TO GO THROUGH, BUT NO OTHERS
IT$ PION
IFN D10+D20,[
SETZM INTALL ;UNDO THE 'DALINT'
PUSHJ P,DISINT ;DISABLE APPROPRIATE INTERRUPTS
] ;END IFN D10+D20
HRRZS (P) ;WILL HRROS IF ASYNCHRONOUS
PUSHJ P,SAVX5 ;SAVE NUMERIC ACS
PUSH FXP,UNREAL
PUSH FXP,SPSV
BG$ PUSH FXP,BNV1
MOVSI R,-LSWS
PUSH FXP,SWS(R)
AOBJN R,.-1
JSP T,SPECBIND ;MUST SPECBIND LISAR
LISAR
SETZM PA4 ;PA4 MUST BE IN THE "SWS" AREA
IFN USELESS, SETZM TYOSW
SETZM INHIBIT
SETZM EOFRTN ;DO NOT SETZM CATRTN! GJS WANTS
SETZM BFPRDP ; TO THROW OUT OF USER INTERRUPTS
SETOM ERRSW
MOVE T,[-LINTPDL,,INTPDL] ;MUSTN'T CALL UINT0 FROM
CAME T,INTPDL ; WITHIN A PI SERVER
.LOSE
REPEAT 3, PUSH FXP,R70 ;RANDOM SLOTS FOR NUMERIC ARGS;
; ; ALSO 4.9 OF TOP ONE => RETURN VALUE MATTERS
UIXPUSH==:6+1+BIGNUM+LSWS+3 ;AMOUNT OF STUFF PUSHED ON FXP
UISWS==:-<LSWS+3>+1 ;WHERE SWS STARTS WHEN SAVED ON FXP
UISAVT==:UISWS-7-BIGNUM ;WHERE ACCUMULATOR T GETS SAVED
PUSH P,[$UIFRAME] ;FRAME MARKER AND PDLS SAVED
PUSH P,FXP ; SO THAT THROW AND FRETURN WIN
HRLM FLP,(P) .SEE UIBRK
PUSHJ FXP,SAV5 ;SAVE ARGUMENT ACS AND 40 ON
PUSH P,40 ; REGPDL FOR GC PROTECTION
PUSH P,PA3
UIFRM==-3-NACS ;LOCATION OF FRAME ON REGPDL
UISAVA==UIFRM+2 ;LOCATION OF AC A ON REGPDL
MOVEI A,UIFRM(P)
MOVEM A,UIRTN
MOVSI AR2A,(CALLF 1,)
HLRZ A,D ;GET FIRST ARG FOR INTERRUPT FN
TRZN D,400000 ;DECODE INTERRUPT TYPE
JRST UINT30
HRRZM D,(FXP) ;TTY INPUT INTERRUPT CHAR
MOVEI R,(D)
MOVE TT,TTSAR(A)
JSP D,TTYICH ;FETCH INTERRUPT FN
MOVSI AR2A,(CALLF 2,)
HRRI AR2A,(R)
MOVEI B,(FXP) ;SECOND ARG IS CHARACTER
JRST UINT31
;UINT30 UINT31 UINT32 UINT33 UINT40 UINT0X UINT0N UINT0Z UINT88 EUINT0 UINT45 UINT46 UINT49 UINT90 UINT91
UINT30: TRZN D,200000
JRST UINT32
MOVEI TT,(D) ;RANDOM FILE INTERRRUPT
ROT TT,-1
HRR AR2A,@TTSAR(A) ;FETCH INTERRUPT FUNCTION
SKIPL TT
HLR AR2A,@TTSAR(A)
UINT31: HRROS UIFRM-1(P) ;ASYNCHRONOUS INTERRUPT
JRST UINT40
UINT32: TRZN D,100000
JRST UINT33
HRRZM A,-1(FXP)
MOVEI A,QODDP(D) ;MACHINE ERROR
MOVEI B,(FXP)
MOVEI C,-1(FXP)
MOVEI AR1,-2(FXP)
MOVSI AR2A,(CALLF 4,)
HRR AR2A,VMERR
JRST UINT40
UINT33: LDB TT,[110200,,D] ;BITS 2.2-2.1 ARE CLASS
ANDI D,777 ;1.9-1.1 ARE SUBTYPE
XCT UINT90(TT) ;FETCH INTERRUPT FUNCTION
XCT UINT91(TT) ;SPECIAL HACKS
UINT40: SKIPGE UIFRM-1(P)
SETOM UNREAL
PIONAGAIN ;***** RE-ENABLE INTERRUPTS *****
IT$ .SUSET [.SDF1,,R70]
IT$ .SUSET [.SDF2,,R70]
TRNN AR2A,-1 ;ONLY PROCESS INTERRUPT IF INT FUNCTION NON-NIL
TDZA A,A ;FORCE A RETURNED VALUE OF NIL IF IT MATTERS
XCT AR2A ;APPLY INTERRUPT FUNCTION
HRRZ T,UIFRM+1(P)
CAIE T,(FXP)
PUSHJ P,UINT45
HLRZ T,UIFRM+1(P)
CAIE T,(FLP)
PUSHJ P,UINT46
PIPAUSE
SKIPGE (FXP) ;IF RETURN VALUE MATTERS
MOVEM A,UISAVA(P) ; SAVE IT FOR RETURN
PUSHJ P,UNBIND ;RESTORE LISAR, ETC.
UINT0X: HRLI R,UISWS(FXP)
HRRI R,SWS
BLT R,SWS+LSWS-1 ;RESTORE SUPER-WRITABLE STUFF
SUB FXP,[-UISWS+1,,-UISWS+1]
BG$ POP FXP,BNV1
POP P,PA3
POP P,40
PUSHJ FXP,RST5M1
POP P,-2(P) ;KNOCK OFF PDLS AND UIFRAME, SAVING
SUB P,R70+1 ; SAVED CONTENTS OF A FOR POPAJ BELOW
POP FXP,SPSV ;Restore state of SPECBINDing
POP FXP,D ;OLD STATE OF UNREAL
SKIPL -1(P) ;IF INTERRUPT WASN'T ASYNCHRONOUS,
JRST UINT88 ; MUSTN'T ATTEMPT TO RESTORE UNREAL
EXCH D,UNREAL ;WELL, WE WANT TO RESTORE IT. WAS IT ON
JUMPE D,UINT88 ; JUST NOW? IF NOT, RETURN.
SKIPE A,UNREAL ;DID WE JUST TURN IT OFF BY RESTORING IT?
JRST UINT0Z ;NO, IT'S STILL ON - RETURN.
UINT0N: HRRZ T,-1(P) ;IS THE CHECKU ROUTINE ITSELF CALLING ME?
CAIGE T,ENOINT ; DON'T WANT TO GET STUCK IN INFINITELY
CAIGE T,NOINTERRUPT ; RECURSIVE CALLS
PUSHJ P,CHECKQ ;HACKISH ENTRY INTO CHECKU
JRST UINT88
UINT0Z: SKIPLE UNREAL
JUMPLE D,UINT0N
UINT88: PUSHJ P,RSTX5
PIONAGAIN ;RE-ENABLE INTERRUPTS
JRST POPAJ
EUINT0:: .SEE PDLOV ;END OF UINT0
UINT45: SKIPA B,[QFIXNUM]
UINT46: MOVEI B,QFLONUM
EXCH A,B
PUSHJ P,UINT49
EXCH A,B
POPJ P,
UINT49: FAC [PDL OUT OF PHASE IN USER INTERRUPT (SYSTEM ERROR)!]
UINT90: HRR AR2A,VALARMCLOCK(D) ;ALARMCLOCK SERIES
HRR AR2A,VAUTFN(D) ;RANDOM SYNCHRONOUS
HRR AR2A,VUDF(D) ;ERINT SERIES
.VALUE ;??
UINT91: HRROS UIFRM-1(P) ;ALARMCLOCK (ASYNCHRONOUS)
JFCL ;RANDOM SYNCHRONOUS
SETOM (FXP) ;ERINT (VALUE MATTERS)
.VALUE ;??
;CKI0 CKI2 CKI2A CKI2F CKI2F1 CKI3 CKI3B RQITR CKI4A CKI1 CKI1A
CKI0: PUSH FXP,D
HRRZ D,INTFLG
CAIN D,-1
JRST CKI1 ;DELAYED USER INTERRUPT
PIPAUSE
CKI2: SETZM UNREAR
CKI2A: SETZM UNRC.G ;CHECKU JOINS IN AT THIS POINT
SETZM INTFLG ; RESET TTY NO RESET
TRNE D,4 ;↑X -6 -2
JRST CKI3 ;↑G -7 -3
IFN ITS+D20,[
PUSH FXP,D
MOVEI F,LCHNTB-1 ;RESET ALL TTY FILES
CKI2F: SKIPN AR1,CHNTB(F)
JRST CKI2F1
MOVE TT,TTSAR(AR1)
TLNN TT,TTS.CL ;DON'T RESET THE FILE IF IT IS CLOSED
TLNN TT,TTS.TY
JRST CKI2F1
MOVEI T,CLRI3
TLNE TT,TTS.IO
MOVEI T,CLRO3
PUSHJ FXP,(T)
CKI2F1: SOJG F,CKI2F
POP FXP,D
] ;END OF IFN ITS+D20
10$ CLRBFO
10$ CLRBFI
CKI3:
CKI3B: TRNN D,2
SKIPE PSYMF
RQITR: LERR [SIXBIT \QUIT!\] ;SO ERROR OUT FOR ↑X
IFN USELESS*ITS,[
MOVE T,IMASK
TRNN T,%PIMAR
JRST CKI4A
.SUSET [.RMARA,,SAVMAR]
.SUSET [.SMARA,,R70] ;AVOID TRIPPING THE MAR DURING THE ERRPOP
CKI4A:
] ;END OF IFN USELESS*ITS
PIONAGAIN
PUSHJ FXP,ERRPOP
PIPAUSE
IFN USELESS*ITS,[
TRNE T,%PIMAR ;ERRPOP PRESERVES T
.SUSET [.SMARA,,SAVMAR]
] ;END OF IFN USELESS*ITS
MOVE A,VERRLIST
MOVEM A,VIQUOTIENT
JSP A,ERINI0
MOVE P,C2 ;DRASTIC ACTION FOR ↑G
SETZM TTYOFF
STRT 17,@RQITR
JRST LSPRT1 ;WILL PION WITHIN ERINIT
CKI1: SKIPE INHIBIT ;RETURN TO SERVICE THE DELAYED INTERRUPT
JRST POPXDJ ;BUT NO SERVICE WHEN INHIBIT = -1
PUSHJ P,UINTPU
SETZM INTFLG
PUSH P,A
PUSH P,A
HLLOS INHIBIT
SKIPG A,INTAR
LERR EMS13 ;LOST USER INTERRUPT
CKI1A: MOVS D,INTAR(A) ;FOR GC PROTECTION
MOVSM D,(P)
SOSG INTAR ;CYCLE THROUGH THE DELAYED INTERRUPTS
SETZM INTFLG ;TO PREVENT TIMING SCREWS, CLEAR INTFLG IF
; NO MORE INTERRUPTS PENDING
PUSHJ P,UINT0
SKIPLE A,INTAR
JRST CKI1A
SUB P,R70+1
POP P,A
SETZM INHIBIT
PUSHJ P,UINTEX
JRST POPXDJ
;UUOH0 UUOH2 UUOH2A UUOACL UUOAJC UUOH0B UUOH0A
SUBTTL UUOH HANDLER (INCLUDING STRT)
;UUOH: 0 ;UUO HANDLER
UUOH0: MOVEM T,UUTSV
LDB T,[331100,,40]
CAIL T,CALL←-33
JRST UUOH0B ;PROBABLY A LISP "CALL" UUO
UUOH2: CAILE T,UUOMAX
SETZ T,
JRST @UUOH2A(T)
UUOH2A: ERRBAD ;0 IS ILGL, ILGL, ILGL
ERROR1 ;LERR ;UNCORRECTABLE LISP ERROR
UUOACL ;ACALL ;KLUDGE FOR NCALLING ARRAYS
UUOAJC ;AJCALL ;JRST VERSION OF ACALL
ERROR1 ;LER3 ;LERR, BUT ALSO PRINT ACCUMULATOR A
ERROR5 ;ERINT ;CORRECTABLE ERROR WITH SIXBIT MSG
POF1 ;PP Z$X ;PRINT OUT Z FROM DDT
STRTOUT ;STRT ;SIXBIT STRING TYPE OUT
ERROR5 ;SERINT ;CORRECTABLE ERROR WITH S-EXP MSG
TOF1 ;TP Z$X ;TYPEP PRINTOUT OF Z FROM DDT
ERRIOJ ;IOJRST ;HAIRY FROB TO GET I/O ERROR MSGS
STRTOUT ;STRT7 ;ASCII STRING TYPE OUT
IFN .-UUOH2A-1-UUOMAX, WARN [UUOH2A OUT OF PHASE]
UUOACL: PUSH P,UUOH
BAKPRO
UUOAJC: MOVE T,@40 .SEE ASAR
TLNE T,AS<FX+FL>
AOJA T,.+2 ;FOR NUMBER ARRAYS, ENTER AT HEADER+1
PUSH P,[UUONVL] ;FOR OTHER ARRAYS, USE NUMVAL CHECK ROUTINE
XCTPRO
EXCH T,UUTSV
SPECPRO INTACT
JRST @UUTSV
NOPRO
;;; DISPATCH ON "CALL" TYPE UUO, TRAPPING TO INTERPRETER IF NECESSARY
UUOH0B: CAILE T,NJCALF←-33
JRST UUOH2
MOVEM TT,UUTTSV
MOVEM R,UURSV
LDB TT,[270400,,40]
CAIG TT,15 ;LISP "CALL" TYPE UUOS
TDZA R,R
MOVEI R,-15(TT)
HRRZ T,40
UUOH0A: MOVEM T,UUOFN
TLZ T,-1
MOVEI TT,(T)
LSH TT,-SEGLOG
SKIPGE TT,ST(TT)
JRST @UUNAF(R)
TLNN TT,SY
JRST UUOH0C
TLZ R,700000 ;400000 => AUTOLOAD, 200000 => MACRO,
; 100000 => ALREADY DID AUTOLOAD
;;; FALLS THRU
;UUOH1 UUOH0C UUOH1A UUOH3B
;;; FALLS THRU
UUOH1: HRRZ T,(T)
JUMPE T,UUOH1A
HLRZ TT,(T)
HRRZ T,(T)
CAIL TT,QARRAY
CAILE TT,QAUTOLOAD
JRST UUOH1
2DIF JRST @(TT),UUOTRT,QARRAY
UUOH0C: TLNN TT,SA
JRST UUOH3A
HRRZ TT,ASAR(T) ;HANDLE CASE OF A SAR EFFICIENTLY
CAIN TT,ADEAD
JRST UUOH3A
MOVSI T,(T)
HRRI T,T
JRST @UUAT(R)
UUOH1A: JUMPL R,UUALT1
TLNE R,200000
JRST UUOMER
PUSH P,A
PUSH P,B
SKIPGE A,UUOFN
JRST UUOUER
HLRZ T,(A) ;OPENCODED SYMEVAL
HRRO T,@(T)
UUOH3B: POP P,B
POP P,A
SKIPN EVPUNT ;SHOULD WE ALLOW FUNCTIONAL VARIABLES?
CAIN T,QUNBOUND ;YES, IS IT BOUND?
JRST UUOH3A ;NO TO EITHER QUESTION, SO ERROR
JRST UUOH0A
;UUOTRT UUAT UUST UUFST UULT UUET UUFET UUNAF UUALT UUMCT UUALT1
;;UUO TRANSFER TABLE, ONCE FUNCTION TYPE IS KNOWN
UUOTRT:
IRPS LL,X,[A+S+FS+L+E+FE+MC-AL-]
IFSE X,+, @UU!LL!T(R)
IFSE X,-, UU!LL!T
TERMIN
;;; MOBY DISPATCH TABLE FOR DECODING UUO CALL TYPES!
;;; R=0 => COMPILED ROUTINE CALLING A SUBR TYPE
;;; R=1 => COMPILED ROUTINE CALLING A LSUBR TYPE
;;; R=2 => COMPILED ROUTINE CALLING A FSUBR TYPE
UUAT: UUOARR ;CALLING SUBR - IT'S AN ARRAY **WIN**
UUOS1A ;CALLING LSUBR - IT'S AN ARRAY
UUOS2A ;CALLING FSUBR - IT'S AN ARRAY
UUST: UUOS0 ;CALLING SUBR - IT'S A SUBR **WIN**
UUOS1 ;CALLING LSUBR - IT'S A SUBR
UUOS2 ;CALLING FSUBR - IT'S A SUBR
UUFST: UUOS10 ;CALLING SUBR - IT'S AN FSUBR
UUOS11 ;CALLING LSUBR - IT'S AN FSUBR
UUOSBR ;CALLING FSUBR - IT'S AN FSUBR **WIN**
UULT: UUOS7 ;CALLING SUBR - IT'S AN LSUBR
UUOLSB ;CALLING LSUBR - IT'S AN LSUBR **WIN**
UUOS9 ;CALLING FSUBR - IT'S AN LSUBR
UUET: UUOEXP ;CALLING SUBR - IT'S AN EXPR
UUOS5 ;CALLING LSUBR - IT'S AN EXPR
UUOS6 ;CALLING FSUBR - IT'S AN EXPR
UUFET: UUOS3 ;CALLING SUBR - IT'S A FEXPR
UUOS4 ;CALLING LSUBR - IT'S A FEXPR
UUOEX2 ;CALLING FSUBR - IT'S A FEXPR
UUNAF: UUOS ;CALLING SUBR - IT'S A NONATOMICFUN
UUL2N ;CALLING LSUBR - IT'S A NONATOMICFUN
UUF2N ;CALLING FSUBR - IT'S A NONATOMICFUN
UUALT: HRRZM T,UUALT9 ;FOUND AN AUTOLOAD PROPERTY
TLOA R,400000
UUMCT: TLO R,200000 ;MACROS ARE IGNORED, SORT OF
JRST UUOH1
UUALT1: TLOE R,100000 ;CALLING ANYTHING - IT'S AN AUTOLOAD
JRST UUOH3C ;LOSE IF JUST DID AN AUTOLOAD ALREADY
PUSH P,A
HLRZ A,@UUALT9 ;OTHERWISE AUTOLOAD THE FUNCTION
MOVE T,UUOFN
PUSHJ P,AUTOLOAD ;BETTER SAVE R, BY GEORGE!
POP P,A
MOVE T,UUOFN
JRST UUOH1 ;NOW TRY IT AGAIN
;UUOBNC UUOBAK UUBKG1 UUOBK7 UUOBK0 UUOBK1 UUOBK8 UUOBK5 UUOBK6
;;; MAY CALL UUOBNC AND UUOBAK ONLY WHEN *RSET IS KNOWN
;;; TO BE NON-NIL - AVOIDS CERTAIN TIMING ERRORS.
UUOBNC: POP P,UUOBKG ;UUOBKG WITH NO CPOPJ
HRROS UUOBKG ;FOR UUO GUYS THAT CALL IAPPLY,
JRST UUOBK0 ; WHICH ITSELF SETS UP A CPOPJ
UUOBAK: POP P,UUOBKG ;WATCH THIS CROCK!
JRST UUOBK7
;;;UUOBKG: 0
UUBKG1: SKIPN V.RSET ;CHECK TO SEE WHETHER IN *RSET MODE
JRST @UUOBKG ;SAVES ALL ACS; T HAS -<# OF ARGS>
UUOBK7: HRRZS UUOBKG
UUOBK0: SKIPE NIL
PUSHJ P,NILBAD
PUSH FXP,TT ;PDLS MUST BE AS FRETURN WOULD WANT
PUSH FXP,R ; TO RESTORE THEM TO
JUMPGE T,UUOBK1 ;IF T>0, THEN ASSUME 0, AND THE
JSP TT,ARGP0 ; ARGS WILL BE FILLED IN LATER
MOVNI TT,(T)
SKIPGE A
SETZ TT,
HRLM TT,(P)
JRST UUOBK8
UUOBK1: PUSH P,R70
UUOBK8: MOVEI TT,-2(FXP)
HRLI TT,(FLP)
PUSH P,TT
HRRZ TT,40
HRLI TT,(SP)
PUSH P,TT
JUMPLE T,UUOBK5
PUSH P,R70
JRST UUOBK6
UUOBK5: PUSH P,[$APPLYFRAME]
UUOBK6: MOVS R,40
HRRI R,CPOPJ
SKIPL UUOBKG ;MAYBE DON'T WANT THE CPOPJ
PUSH P,R
HRRZS UUOBKG
POP FXP,R
POP FXP,TT
JRST @UUOBKG
;UUOSBR UUOSB2 UUOSB3 UEOSB5 UUOSB6 UUOSB7 UUOSB4 UUOXT0 UUOXIT UUOXT1 UUOXCT UUOACS
UUOSBR: HLRZ T,(T) ;*** FSUBR CALLED LIKE FSUBR
MOVEM P,UUPSV
MOVNI R,1
TLOA A,400000
UUOSB2: MOVEI R,1 ;R>0 SAYS DON'T DO FRAME HACKERY
UUOSB3: MOVE TT,40 ;OTHERWISE R HAS -<# OF ARGS>
UUOSB5: TLO T,(PUSHJ P,)
TLNE TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
TLCA T,(JRST#<PUSHJ P,>)
PUSH P,UUOH
UUOSB6: JUMPG R,UUOSB7
EXCH T,R
JSR UUOBKG
EXCH T,R
UUOSB7: TLZ A,-1
TLNE TT,(20←33) ;THE NUMERIC CALL BIT. SEE DEFINITION OF NCALL
AOS T ;FOR NCALL, ENTER AT ENTRY+1
SKIPN VNOUUO
TLNE TT,(2←33) ;THE NO-CLOBBER BIT. SEE DEFINITION OF CALLF
JRST UUOXT0
SOS TT,UUOH
UUOSB4: LDB R,[331100,,(TT)]
CAIN R,XCT←-33
JRST UUOXCT ;MAKE XCT OF UUO WORK
MOVEM T,(TT)
UUOXT0: TLNN T,(34←33) ;CAUSE EXIT TO INDIRECT THRU ACALL
TLO T,(@)
UUOXIT: EXCH T,UUTSV
UUOXT1: MOVE TT,UUTTSV
MOVE R,UURSV
JRST @UUTSV
UUOXCT: LDB R,[220400,,(TT)] ;GET INDEX FIELD OF XCT
JUMPE R,.+2
HRRZ R,@UUOACS-1(R) ;IF NON-ZERO, GET CONTENTS OF THAT AC
ADD R,(TT) ;ADD IN ADDRESS FIELD
HLL R,(TT)
MOVEI TT,(R)
TLNE R,(@)
JRST UUOXCT ;MAKE INDIRECTION WIN
JRST UUOSB4 ;MAKE XCT OF XCT ... OF XCT OF UUO WIN
;;; TABLE OF WHERE TO FIND THE ACS AS THEY WERE ON UUO ENTRY
UUOACS:
IRPS X,,[A B C AR1 AR2A UUTSV UUTTSV D UURSV F FREEAC UUPSV FLP FXP SP]
X
TERMIN
;UUOARR UUOS0 UUOS03 UUOAR2 UUONVL FIX7 UUOS1E UUOS2E UUOE3
UUOARR: HLRZ R,(T) ;*** ARRAY CALLED LIKE SUBR
MOVSI TT,(@)
JRST UUOS03
UUOS0: SETZ TT, ;*** SUBR CALLED LIKE SUBR
HRRZ R,UUOFN
UUOS03: MOVEM P,UUPSV ;THIS IS TO HELP UUOXCT
HLR TT,(T)
PUSH P,TT
LDB T,[270400,,40]
MOVNS T
PUSH FXP,T
PUSHJ P,ARGCHK ;SKIPS IF OK
JRST UUOS0E
POP FXP,R ;R NOW HAS -<# OF ARGS>
POP P,T
TLNN T,(@) ;FURTHER WORK NEEDED FOR CALLING AN ARRAY
JRST UUOSB3
MOVSI TT,TTS<CN>
HLL A,40 ;UUOSB7 WILL CLEAR LEFT HALF OF A
TLNN A,2000 ;DO NOT SET THE COMPILED-CODE-
IORM TT,TTSAR(T) ; NEEDS-ME BIT FOR A CALLF!
MOVE TT,40
TLZN TT,(20←33)
JRST UUOSB3
TLNN TT,(2←33)
JRST UUOAR2 ;NCALL'ING AN ARRAY MEANS CLOBBER,
PUSH P,[UUONVL] ; IF ANY, SHOULD BE TO ACALL
JRST UUOSB5
UUOAR2: TLNN TT,1000
TLOA T,(ACALL) ;NCALL, BUT NOT NCALLF => ACALL
TLOA T,(AJCALL) ;NJCALL, BUT NOT NJCALF => AJCALL
PUSH P,UUOH
TLZ TT,777000
TLZ T,(@)
JRST UUOSB6
UUONVL: SKOTT A,FX+FL
JRST UUONVE
FIX7: MOVE TT,(A) ;OF COURSE, THE ROUTINE HAD BETTER COME UP
POPJ P, ;WITH SOME LISP NUMBER AS VALUE
UUOS1E: PUSH FXP,D
MOVEI D,1
JRST UUOE3
UUOS2E: MOVEM D,(FXP) ;TAKE THE SPOT ALREADY PUSHED ON FXP
MOVEI D,3
UUOE3: PUSHJ P,SAVX3 ;ARGS WERE ALREADY ON PDL, HEL¬π
A5+'(A
A!∨A! λA=
~∀%≠∨- 4A∧Y#_c'∧∩m'≡A/∀A≠∪∂!(Aβ&↓/ →_↓→∪'(↓)⊃ ~↓+ A/!∪→
A]
O%
↓β(A∪P~∀∪!U'⊂A
a Y(~(∪!+'!∀A
1@Y→∪'Q0~∀∪A∨ A
a Y(~(∪≠∨-∀A∧Y#_c'∧~(∪∃%'PA++∨∀d~∀wU+∨&A∀A++∨La A+U∨
dAU+∨'
DA++∨Lb~∀~)++∨&A
tβ'U∧A YHn`Vb4∃++∨La `(MαVN!∧2bA2 h(&B-~")ααbNεZC_4(εlzR⊗%∧!1@4U*V>∃∪P&R2t)α⊃1⊂In⊃↓
qI↓urα⊗b&"αε∩∩∀*NMα bJ⊗ε%Iα
⊗,qα"ε≤Z⊗⊂4PJ*JN"↓1-PhP&6>4)αI1#4(&$b:9α⊂aEAAh(&B-~!αAe*V> hP&BV≤B)α~E↓2Nε3*5D4PJBVNBαA2n-*>N∃
h4(&lzZ∃α%!1Q@hP&"Je→αRPhP&BV≤AαA2% %n: j∃α>2α~V:≥"&>9∧J9α2@h(&R∀r9α⊃cλ%mEs ↓uy∧b&NRLr≥α"
→αε2∀*ε∩e∧∩⊗⊗9∧">:∀hP&*NααRQ2
∩≡A@KZεJ≡~αR=α5*:∞RLz9α:⎇9α>9¬α∩04PJ6>Z,iα⊃1k "~bαH4(&¬*N")¬↓2JN%AL%n∀*∞VB-∩εR∃αiα&→¬α>NNL∩2∃1∧"=α~-9α⊗Z bVεRLz84(LRJNQ¬::ε⊗∃⊂%n>∩α⊗2N*α∞Jεαα>VQ∧z9α↑∀z:≥αu*6
⊗∩αεJ≡_h*VV⎇~∃EhMαVN"Rα~bAe∩NQVkλ4(&∧zAα~E↓2⊂4PJB>BRαA04Ph*VV⎇→Eh&E∩Jiα%!1"QHH%m)RQαNV∃⊃α∞εdb⊗⊃αdJ.∃αe~V
HhP&"2∃QαQ1E!$4(L*b∞!¬!2VV%~X4(LRNAα∩bB∩2
∩≤4(LBJJi¬⊃2VV|284(MαVN"RαA2ε∀:∞-@HIn~>∀~∃α∞D*∞.& OF NUMBER OF ARGS
JRST UUOS0F
MOVE TT,40
TLNE TT,(20←33) ;THE NCALL BIT
AOS UUTSV
TLNN TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
PUSH P,UUOH
JSR UUOBKG
JRST UUOXT1
;UUOX4B UUOLSB UUOLB3 UUOLB4 UUOFUL
UUOX4B: SKIPN UUOH ;=0 MEANS ENTRY FROM MAP SERIES
JRST (R)
PUSHJ FXP,SAV5M1
PUSH P,CR5M1PJ
JRST (R)
UUOLSB: MOVEM P,UUPSV ;*** LSUBR CALLED LIKE LSUBR
MOVEI A,NIL
HLRZ T,(T)
SKIPN V.RSET
JRST UUOSB2
PUSH FXP,T ;SAVE T (ADDRESS OF LSUBR)
MOVE T,UUTSV
PUSH FXP,T ;SAVE -<# OF ARGS> FOR UUOFUL
HRRZ R,UUOFN ;FOR ARGCK0
PUSHJ P,ARGCK0
JRST UUOS1E
MOVE R,T ;WATCH THIS SHUFFLING OF R, T, AND UUTSV!
JSP T,NPUSH-6 ;SIX SLOTS FOR "APPLY FRAME", ETC.
MOVE T,UUTSV
MOVEM R,UUTSV
MOVEI T,(P)
UUOLB3: AOJG R,UUOLB4 ;SO SLIDE STUFF SIX SLOTS UP THE PDL
MOVE TT,-6(T) ;AT END, T POINTS TO LAST OF THE FIVE
MOVEM TT,(T) ; FRAME SLOTS FOR UUOFUL
SOJA T,UUOLB3
UUOLB4: MOVE TT,40 ;FIGURE OUT IF CALL OR CALLF TYPE
MOVEI R,CPOPJ ; (MAY BE CALL TYPE IF 0 ARGS)
TLO R,(PUSHJ P,) ;FIGURE IT OUT
TLNE TT,1000 ;IT MAY LOOK LIKE WE'RE CONSTRUCTING A PUSHJ
TLCA R,(JRST#<PUSHJ P,>) ; TO THE WRONG PLACE, BUT READ THIS CAREFULLY!
HRR R,UUOH ;RETURN ADDRESS MUST GO UNDER
HRRZM R,-5(T) ; THE FRAME, NOT OVER!!!
HLLM R,-1(FXP) ;SAVE INSTRUCTION TO CLOBBER WITH
MOVEI TT,(T)
PUSHJ P,UUOFUL ;SO STICK AN APPLY FRAME UNDER ARGS, IF ANY
;REMEMBER, UUOFUL EXPECTS TWO FROBS
; ON FXP, AND POPS ONE OF THEM
POP FXP,T ;RESTORE T (ADDRESS OF LSUBR)
MOVE TT,40
JRST UUOSB7
UUOFUL: MOVS R,40 ;PUT FRAME UNDER LSUBR CALL
HRRI R,CPOPJ ;TT POINTS TO LAST OF 5 PDL SLOTS
MOVEM R,(TT) ;USES T,TT,R
MOVEI R,-2(FXP) ;FXP HAS -<# OF ARGS> AND ONE
HRRM R,-3(TT) ; OTHER SLOT AS WELL
HRLM FLP,-3(TT)
HRLM SP,-2(TT)
HRRZ R,40
HRRM R,-2(TT)
POP FXP,T
MOVEI R,(T)
HRLI R,-1(T)
ADDI R,(P)
SKIPN T
SETZ R,
MOVEM R,-4(TT)
MOVE R,[$APPLYFRAME]
MOVEM R,-1(TT)
POPJ P,
;UUOS9 UUOS7 UUOS7A UUOS7H UUOS7K
UUOS9: SKIPA TT,CILIST ;*** LSUBR CALLED LIKE FSUBR
UUOS7: MOVEI TT,ARGPDL ;*** LSUBR CALLED LIKE SUBR
MOVE R,40
TLNN R,1000
PUSH P,UUOH
HLRZ T,(T)
TLNE R,(20←33) ;THE NCALL BIT
ADDI T,1
PUSH FXP,T
PUSH FXP,XC-1
SKIPN V.RSET
JRST UUOS7A
MOVEI T,1
PUSHJ P,UUOBAK
REPEAT 2, SOS -3(P) ;ALLOW FOR TWO FROBS ON FXP
HRRZM P,(FXP)
UUOS7A: JSP TT,(TT) ;ARGPDL OR ILIST
POP FXP,R
JUMPL R,UUOS7K
SKIPN TT,T
JRST UUOS7H
HRLI TT,-1(TT)
ADDI TT,1(P)
UUOS7H: MOVEM TT,-4(R)
MOVE TT,[$APPLYFRAME]
MOVEM TT,-1(R) ;APPLYFRAME DONE
UUOS7K: MOVEM T,UUTSV
HRRZ R,UUOFN
PUSHJ P,ARGLCK
JRST UUOS2E
POP FXP,T
MOVEI A,0
JRST UUOXIT
;UUOS2A UUOS2 UUOS2Q CILIST UUOS1A
UUOS2A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE FSUBR
MOVEM TT,LISAR
MOVEI R,(TT)
MOVEI TT,IAPAR1
JRST UUOS2Q
UUOS2: HLRZ TT,(T) ;*** SUBR CALLED LIKE FSUBR
HRRZ R,UUOFN
UUOS2Q: MOVE T,40
TLNN T,1000
PUSH P,UUOH
TLNE T,(NCALL)
PUSH P,[UUONVL]
CAIN T,IAPAR1
PUSH P,LISAR
PUSH FXP,TT ;SUBR ADDR
CILIST: JSP TT,ILIST ;ILIST FORTUNATELY SAVES R
PUSHJ P,ARGCHK
JRST UUOS2E
JSP R,PDLARG
POP FXP,TT ;PRESERVE T FOR UUOBKG
CAIN TT,IAPAR1
POP P,LISAR
JSR UUOBKG
MOVEI T,(TT) ;BEWARE! LOOSE SUBR POINTER
JRST UUOXIT
UUOS1A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE LSUBR
MOVEM TT,LISAR
MOVEI T,IAPAR1 ;HAIR SO INTERRUPTS WON'T SCREW US
EXCH T,UUTSV
JSP R,PDLARG ;SAVES TT
JSR UUOBKG ;ALSO SAVES TT, AND WANTS NOTHING ON PDLS
LDB R,[TTSDIM,,TTSAR(TT)]
MOVE TT,40
TLNN TT,1000
PUSH P,UUOH
TLNE TT,(NCALL)
PUSH P,[UUONVL]
MOVNI R,(R)
CAMN R,T
JRST UUOXT1
PUSH FXP,D
PUSHJ P,SAVX3
MOVEI D,2
JRST UUOE2
;UUOS4 UUF2N UUOS6 UUOS6Q UUOS11
;;; PUTCODE [EXPR ← FSUBR]40
UUOS4: POP P,A ;*** FEXPR CALLED LIKE LSUBR
MOVN TT,UUTSV
JRST UUOS4A
UUF2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE FSUBR
UUOS6: HLRZ TT,(T) ;*** EXPR CALLED LIKE FSUBR
MOVE R,40
TLZN TT,-1 ;UUF2N LEAVES LH OF T ↑= 0
HRL TT,R ;OTHERWISE GET SUBR EXPR NAME IN LH
TLNN R,1000
PUSH P,UUOH
TLNE R,(20←33) ;THE NCALL BIT
PUSH P,[UUONVL]
JSP R,UUOX4B
SKIPN V.RSET
JRST UUOS6Q
PUSH P,FXP ;IF IN *RSET MODE, MAKE
HRLM FLP,(P) ; UP AN EVAL FRAME (SEE EVAL
MOVEI C,(A) ; FOR FORMAT THEREOF)
HRRZ B,40
PUSHJ P,XCONS ;MUST CONS UP FAKE ARG TO EVAL
PUSH P,A
HRLM SP,(P)
PUSH P,[$EVALFRAME]
MOVEI A,(C)
UUOS6Q: PUSH P,TT ;PUSH OF FUNCTION
MOVEI TT,IAPPLY
JRST ILIST
UUOS11: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE LSUBR
MOVE T,UUTSV
JRST UUS10A
;;; ENDCODE [EXPR ← FSUBR]
;UUOS3 UUOS4A UUOEX2 UUOS UUOEXP UUOEX4 UUOS10 UUS10A
UUOS3: LDB TT,[270400,,40] ;*** FEXPR CALLED LIKE SUBR
UUOS4A: SOJN TT,UUOFER
UUOEX2: MOVEI TT,1 ;*** FEXPR CALLED LIKE FSUBR
DPB TT,[270400,,40]
TLOA A,400000
UUOS: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE SUBR
UUOEXP: HLRZ TT,(T) ;*** EXPR CALLED LIKE SUBR
LDB T,[270400,,40]
UUOEX4: MOVE R,40 ;ALL OF T,TT,R WILL BE LOST!
TLZN TT,-1 ;INSERT EXPR NAME IF WAS EXPR
HRL TT,R
TLNN R,1000
PUSH P,UUOH
MOVN T,T
SKIPE V.RSET
PUSHJ P,UUOBNC
TLNE R,(NCALL)
PUSH P,[UUONVL]
JSP R,UUOX4B
PUSH P,TT ;PUSH FUNCTION
JUMPE T,IAPPLY
MOVEM T,UUTSV
HRLZ R,UUTSV
MOVE A,1(R)
JSP T,PDLNMK
PUSH P,A ;PUSH ARGUMENT
AOBJN R,.-3
MOVE T,UUTSV
JRST IAPPLY ;APPLY FUN TO ARGS
UUOS10: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE SUBR
JSP TT,ARGPDL
UUS10A: AOJN T,UUOFER
POP P,A
MOVSI T,2000
IORM T,40
MOVE T,UUOFN
JRST UUOSBR